Skip to content

Updates for OpenMP #1

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wfcooke wants to merge 4 commits into
base: pmt_constraint
Choose a base branch
from
Open

Updates for OpenMP #1

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
78f03d6
Updates for OpenMP
wfcooke Jan 16, 2020
b04529e
Fix of indexing issues for Polar moisture transport.
wfcooke Jan 17, 2020
fc64aa9
Remove reference to pmt restart
MJHarrison-GFDL Jan 23, 2020
4a23fd1
Merge pull request #1 from MJHarrison-GFDL/pmt_constraint_fv3
wfcooke Jan 24, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 9 additions & 4 deletions atm_land_ice_flux_exchange.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2011,8 +2011,9 @@ subroutine flux_down_from_atmos (Time, Atm, Land, Ice, Atmos_boundary, Land_boun
do j=js_atm,je_atm
do i=is_atm,ie_atm
if (Smb(k)%mask(i,j) .eq. 1.0) then
Atm%lprec(i,j)=Atm%lprec(i,j)*Smb(k)%scale_factor
Atm%fprec(i,j)=Atm%fprec(i,j)*Smb(k)%scale_factor
!Atm%lprec, Atm%fprec are (1:ie_atm-is_atm+1,1:je_atm-js_atm+1)
Atm%lprec(i-is_atm+1,j-js_atm+1)=Atm%lprec(i-is_atm+1,j-js_atm+1)*Smb(k)%scale_factor
Atm%fprec(i-is_atm+1,j-js_atm+1)=Atm%fprec(i-is_atm+1,j-js_atm+1)*Smb(k)%scale_factor
endif
enddo
enddo
Expand Down Expand Up @@ -3900,7 +3901,9 @@ subroutine update_surface_mass_balance(Atm, LIAb, Smb,Time)

do j=js,je
do i=is,ie
Smb%smb_in(i,j) = Smb%mask(i,j)*Atm%grid%area(i,j)*(Atm%lprec(i,j) + Atm%fprec(i,j))
!Atm%grid%area, LIAb%lhflx are (is:ie,js:je)
!Atm%lprec, Atm%fprec are (1:ie-is+1,1:je-js+1)
Smb%smb_in(i,j) = Smb%mask(i,j)*Atm%grid%area(i,j)*(Atm%lprec(i-is+1,j-js+1) + Atm%fprec(i-is+1,j-js+1))
Smb%smb_out(i,j) = Smb%mask(i,j)*Atm%grid%area(i,j)*LIAb%lhflx(i,j)
Smb%smb(i,j) = Smb%smb_in(i,j) - Smb%smb_out(i,j)
enddo
Expand Down Expand Up @@ -3964,7 +3967,9 @@ subroutine smb_balance(Atm,SmbA,SmbB,SmbC,LIAb)

do j=js,je
do i=is,ie
SmbC%smb_in(i,j) = SmbC%mask(i,j)*Atm%grid%area(i,j)*(Atm%lprec(i,j) + Atm%fprec(i,j))
!Atm%grid%area, LIAb%lhflx are (is:ie,js:je)
!Atm%lprec, Atm%fprec are (1:ie-is+1,1:je-js+1)
SmbC%smb_in(i,j) = SmbC%mask(i,j)*Atm%grid%area(i,j)*(Atm%lprec(i-is+1,j-js+1) + Atm%fprec(i-is+1,j-js+1))
SmbC%smb_out(i,j) = SmbC%mask(i,j)*Atm%grid%area(i,j)*LIAb%lhflx(i,j)
SmbC%smb(i,j)=SmbC%smb_in(i,j)-SmbC%smb_out(i,j)
enddo
Expand Down
117 changes: 60 additions & 57 deletions coupler_main.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -836,7 +836,8 @@ program coupler_main
!$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) &
!$OMP& SHARED(Ocean_ice_boundary) &
!$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) &
!$OMP& SHARED(newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki, newClockj, newClockl)
!$OMP& SHARED(newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki, newClockj, newClockl) &
!$OMP& SHARED(adjust_surface_mass_balance, Smb_n, Smb_s, Smb_c)
!$ if (omp_get_thread_num() == 0) then
!$OMP PARALLEL &
!$OMP& NUM_THREADS(1) &
Expand All @@ -846,9 +847,11 @@ program coupler_main
!$OMP& SHARED(Time_atmos, Atm, Land, Ice, Land_ice_atmos_boundary, Atmos_land_boundary, Atmos_ice_boundary) &
!$OMP& SHARED(Ocean_ice_boundary) &
!$OMP& SHARED(do_debug, do_chksum, do_atmos, do_land, do_ice, do_concurrent_radiation, omp_sec, imb_sec) &
!$OMP& SHARED(newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki, newClockj, newClockl)
!$OMP& SHARED(newClockc, newClockd, newClocke, newClockf, newClockg, newClockh, newClocki, newClockj, newClockl) &
!$OMP& SHARED(adjust_surface_mass_balance, Smb_n, Smb_s, Smb_c)
!$ call omp_set_num_threads(atmos_nthreads)
!$ dsec=omp_get_wtime()

if (do_concurrent_radiation) call mpp_clock_begin(newClocki)

! ---- atmosphere dynamics ----
Expand Down Expand Up @@ -961,6 +964,7 @@ program coupler_main
!$OMP& SHARED(newClockj)
!$ call omp_set_num_threads(radiation_nthreads)
!$ dsec=omp_get_wtime()

call mpp_clock_begin(newClockj)
call update_atmos_model_radiation( Land_ice_atmos_boundary, Atm )
call mpp_clock_end(newClockj)
Expand Down Expand Up @@ -1272,7 +1276,6 @@ subroutine coupler_init
endif

!----- read date and calendar type from restart file -----

if (file_exist('INPUT/coupler.res')) then
!Balaji: currently written in binary, needs form=MPP_NATIVE
call mpp_open( unit, 'INPUT/coupler.res', action=MPP_RDONLY )
Expand Down Expand Up @@ -1994,7 +1997,7 @@ subroutine coupler_init
lat1=SMB_n%lat_south*atan(1.0)/45.0
lat2=SMB_n%lat_north*atan(1.0)/45.0
do j=js,je ; do i=is,ie
if (lat1<Atm%lat_bnd(i,j) .and. Atm%lat_bnd(i,j+1)<=lat2) then
if (lat1<Atm%lat_bnd(i-is+1,j-js+1) .and. Atm%lat_bnd(i-is+1,j-js+2)<=lat2) then
Smb_n%mask(i,j)=1.0
endif
enddo; enddo
Expand All @@ -2004,7 +2007,7 @@ subroutine coupler_init
lat1=SMB_s%lat_south*atan(1.0)/45.0
lat2=SMB_s%lat_north*atan(1.0)/45.0
do j=js,je ; do i=is,ie
if (lat1<Atm%lat_bnd(i,j) .and. Atm%lat_bnd(i,j+1)<=lat2) then
if (lat1<Atm%lat_bnd(i-is+1,j-js+1) .and. Atm%lat_bnd(i-is+1,j-js+2)<=lat2) then
Smb_s%mask(i,j)=1.0
endif
enddo; enddo
Expand All @@ -2014,7 +2017,7 @@ subroutine coupler_init
lat1=SMB_c%lat_south*atan(1.0)/45.0
lat2=SMB_c%lat_north*atan(1.0)/45.0
do j=js,je ; do i=is,ie
if (lat1<Atm%lat_bnd(i,j) .and. Atm%lat_bnd(i,j+1)<=lat2) then
if (lat1<Atm%lat_bnd(i-is+1,j-js+1) .and. Atm%lat_bnd(i-is+1,j-js+2)<=lat2) then
Smb_c%mask(i,j)=1.0
endif
enddo; enddo
Expand Down Expand Up @@ -2046,57 +2049,57 @@ subroutine coupler_init
allocate(Smb_c%smb_hist(pmt_window)); Smb_c%smb_hist(:)=0.0
endif

if (associated(Smb_n%smb_hist)) then
filename='pmt_n.res.nc'
filename = 'INPUT/'//trim(filename)
fieldname='poleward_moisture_transport'
allocate(Smb_n%restart_file)
id_restart = register_restart_field(Smb_n%restart_file, filename, &
fieldname, Smb_n%smb_hist)
if ( field_exist(filename, fieldname) ) then
other_fields_exist = .true.
write (outunit,*) trim(note_header), ' Reading restart info for ', &
trim(fieldname), ' from ', trim(filename)
call read_data(filename, fieldname, Smb_n%smb_hist)
else
call mpp_error(WARNING, trim(error_header) // ' Couldn''t find field ' // &
trim(fieldname) // ' in file ' //trim(filename))
endif
endif
if (associated(Smb_s%smb_hist)) then
filename='pmt_s.res.nc'
filename = 'INPUT/'//trim(filename)
fieldname='poleward_moisture_transport'
allocate(Smb_s%restart_file)
id_restart = register_restart_field(Smb_s%restart_file, filename, &
fieldname, Smb_s%smb_hist)
if ( field_exist(filename, fieldname) ) then
other_fields_exist = .true.
write (outunit,*) trim(note_header), ' Reading restart info for ', &
trim(fieldname), ' from ', trim(filename)
call read_data(filename, fieldname, Smb_s%smb_hist)
else
call mpp_error(WARNING, trim(error_header) // ' Couldn''t find field ' // &
trim(fieldname) // ' in file ' //trim(filename))
endif
endif
if (associated(Smb_c%smb_hist)) then
filename='pmt_c.res.nc'
filename = 'INPUT/'//trim(filename)
fieldname='poleward_moisture_transport'
allocate(Smb_c%restart_file)
id_restart = register_restart_field(Smb_c%restart_file, filename, &
fieldname, Smb_s%smb_hist)
if ( field_exist(filename, fieldname) ) then
other_fields_exist = .true.
write (outunit,*) trim(note_header), ' Reading restart info for ', &
trim(fieldname), ' from ', trim(filename)
call read_data(filename, fieldname, Smb_c%smb_hist)
else
call mpp_error(WARNING, trim(error_header) // ' Couldn''t find field ' // &
trim(fieldname) // ' in file ' //trim(filename))
endif
endif
! if (associated(Smb_n%smb_hist)) then
! filename='pmt_n.res.nc'
! filename = 'INPUT/'//trim(filename)
! fieldname='poleward_moisture_transport'
! allocate(Smb_n%restart_file)
! id_restart = register_restart_field(Smb_n%restart_file, filename, &
! fieldname, Smb_n%smb_hist)
! if ( field_exist(filename, fieldname) ) then
! other_fields_exist = .true.
! write (outunit,*) trim(note_header), ' Reading restart info for ', &
! trim(fieldname), ' from ', trim(filename)
! call read_data(filename, fieldname, Smb_n%smb_hist)
! else
! call mpp_error(WARNING, trim(error_header) // ' Couldn''t find field ' // &
! trim(fieldname) // ' in file ' //trim(filename))
! endif
! endif
! if (associated(Smb_s%smb_hist)) then
! filename='pmt_s.res.nc'
! filename = 'INPUT/'//trim(filename)
! fieldname='poleward_moisture_transport'
! allocate(Smb_s%restart_file)
! id_restart = register_restart_field(Smb_s%restart_file, filename, &
! fieldname, Smb_s%smb_hist)
! if ( field_exist(filename, fieldname) ) then
! other_fields_exist = .true.
! write (outunit,*) trim(note_header), ' Reading restart info for ', &
! trim(fieldname), ' from ', trim(filename)
! call read_data(filename, fieldname, Smb_s%smb_hist)
! else
! call mpp_error(WARNING, trim(error_header) // ' Couldn''t find field ' // &
! trim(fieldname) // ' in file ' //trim(filename))
! endif
! endif
! if (associated(Smb_c%smb_hist)) then
! filename='pmt_c.res.nc'
! filename = 'INPUT/'//trim(filename)
! fieldname='poleward_moisture_transport'
! allocate(Smb_c%restart_file)
! id_restart = register_restart_field(Smb_c%restart_file, filename, &
! fieldname, Smb_s%smb_hist)
! if ( field_exist(filename, fieldname) ) then
! other_fields_exist = .true.
! write (outunit,*) trim(note_header), ' Reading restart info for ', &
! trim(fieldname), ' from ', trim(filename)
! call read_data(filename, fieldname, Smb_c%smb_hist)
! else
! call mpp_error(WARNING, trim(error_header) // ' Couldn''t find field ' // &
! trim(fieldname) // ' in file ' //trim(filename))
! endif
! endif
endif

call mpp_set_current_pelist()
Expand Down