Skip to content

Commit

Permalink
Some style updates to make the code easier to read.
Browse files Browse the repository at this point in the history 
Identical results are given to older GNU and Intel compiler runs.
  • Loading branch information
@emkemp
emkemp committed Feb 1, 2024
1 parent bb1a6f3 commit 82f8083
Show file tree
Hide file tree
Showing 5 changed files with 438 additions and 349 deletions.
144 changes: 74 additions & 70 deletions lis/metforcing/mogreps_g/get_cdf_params.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,169 +28,172 @@ subroutine get_cdf_params (n, fname, month, param_a, param_b, mean, std)

implicit none

!ARGUMENTS:
!ARGUMENTS:
integer, intent(in) :: n
character(len=*), intent(in) :: fname
integer, intent(in) :: month ! month of year (1-12)

!EOP
logical :: file_exists
integer :: ftn
integer :: param_a_id, param_b_id, mean_id, std_id, ngrid_id, nlead_id
integer :: ngrid, nlead
integer :: r, c, nc, c1, r1, gid, l
real,allocatable :: param_hires(:,:)
real,allocatable :: param_hires_2d(:,:)
real :: param_a(LIS_rc%ngrid(n),8) !8: lead time
real :: param_b(LIS_rc%ngrid(n),8)
real :: mean(LIS_rc%ngrid(n),8)
real :: std(LIS_rc%ngrid(n),8)

! check file
!EOP
logical :: file_exists
integer :: ftn
integer :: param_a_id, param_b_id, mean_id, &
std_id, ngrid_id, nlead_id
integer :: ngrid, nlead
integer :: r, c, nc, c1, r1, gid, l
real, allocatable :: param_hires(:,:)
real, allocatable :: param_hires_2d(:,:)
real :: param_a(LIS_rc%ngrid(n),8) !8:lead time
real :: param_b(LIS_rc%ngrid(n),8)
real :: mean(LIS_rc%ngrid(n),8)
real :: std(LIS_rc%ngrid(n),8)

! check file
inquire(file=fname, exist=file_exists)
if(.not. file_exists) then
write(LIS_logunit,*) '[ERR] ',trim(fname)//' does not exist'
if (.not. file_exists) then
write(LIS_logunit,*) '[ERR] ', trim(fname) // ' does not exist'
call LIS_endrun()
endif

write(LIS_logunit,*)'[INFO] Getting MOGREPS-G bias correction parameters ', trim(fname)
write(LIS_logunit,*) &
'[INFO] Getting MOGREPS-G bias correction parameters ', trim(fname)
call LIS_verify(nf90_open(path=trim(fname), mode=NF90_NOWRITE, &
ncid=ftn), 'nf90_open failed in get_cdf_params')

call LIS_verify(nf90_inq_dimid(ftn, "ngrid", ngrid_id), &
'nf90_inq_dimid failed for ngrid in get_cdf_params')
'nf90_inq_dimid failed for ngrid in get_cdf_params')
call LIS_verify(nf90_inquire_dimension(ftn, ngrid_id, len=ngrid),&
'nf90_inquire_dimension failed for ngrid in get_cdf_params')
'nf90_inquire_dimension failed for ngrid in get_cdf_params')

if(LIS_rc%gnc(n)*LIS_rc%gnr(n) .ne. ngrid) then
write(LIS_logunit,*) 'The input dimensions of the '//trim(fname)
if (LIS_rc%gnc(n)*LIS_rc%gnr(n) .ne. ngrid) then
write(LIS_logunit,*) '[ERR] The input dimensions of the '//trim(fname)
write(LIS_logunit,*) '(',ngrid,')'
write(LIS_logunit,*) 'does not match the dimensions in the LIS parameter file'
write(LIS_logunit,*) &
'does not match the dimensions in the LIS parameter file'
write(LIS_logunit,*) '(',LIS_rc%gnc(n)*LIS_rc%gnr(n),')'
call LIS_endrun()
endif

call LIS_verify(nf90_inq_dimid(ftn, "lead_time", nlead_id), &
'nf90_inq_dimid failed for nlead in get_cdf_params')
'nf90_inq_dimid failed for nlead in get_cdf_params')
call LIS_verify(nf90_inquire_dimension(ftn, nlead_id, len=nlead),&
'nf90_inquire_dimension failed for nlead in get_cdf_params')
'nf90_inquire_dimension failed for nlead in get_cdf_params')

allocate(param_hires(LIS_rc%gnc(n)*LIS_rc%gnr(n),nlead))
allocate(param_hires(LIS_rc%gnc(n)*LIS_rc%gnr(n),nlead))
allocate(param_hires_2d(LIS_rc%gnc(n),LIS_rc%gnr(n)))

param_hires = -9999.0
param_hires_2d = -9999.0

! read param_a
call LIS_verify(nf90_inq_varid(ftn,'cdf_param_a',param_a_id), &
call LIS_verify(nf90_inq_varid(ftn, 'cdf_param_a', param_a_id), &
'nf90_inq_varid failed for cdf_param_a in get_cdf_params')
call LIS_verify(nf90_get_var(ftn, param_a_id, param_hires, &
start=(/1,1,month/), count=(/ngrid,nlead,1/)),&
start=(/1,1,month/), count=(/ngrid,nlead,1/)), &
'nf90_get_var failed for cdf_param_a in get_cdf_params')
do l=1,nlead

do l = 1, nlead
! 1D -> 2D
do r=1,LIS_rc%gnr(n)
do c=1,LIS_rc%gnc(n)
param_hires_2d(c,r)=param_hires(c+(r-1)*LIS_rc%gnc(n),l)
do r = 1, LIS_rc%gnr(n)
do c = 1, LIS_rc%gnc(n)
param_hires_2d(c,r) = param_hires(c+(r-1)*LIS_rc%gnc(n),l)
enddo
enddo

!subsets the data for each processor's domain
nc = (LIS_ewe_halo_ind(n,LIS_localPet+1)-LIS_ews_halo_ind(n,LIS_localPet+1))+1
do r=LIS_nss_halo_ind(n,LIS_localPet+1),LIS_nse_halo_ind(n,LIS_localPet+1)
do c=LIS_ews_halo_ind(n,LIS_localPet+1),LIS_ewe_halo_ind(n,LIS_localPet+1)
c1 = c-LIS_ews_halo_ind(n,LIS_localPet+1)+1
r1 = r-LIS_nss_halo_ind(n,LIS_localPet+1)+1
do r = LIS_nss_halo_ind(n,LIS_localPet+1),LIS_nse_halo_ind(n,LIS_localPet+1)
do c = LIS_ews_halo_ind(n,LIS_localPet+1),LIS_ewe_halo_ind(n,LIS_localPet+1)
c1 = c - LIS_ews_halo_ind(n,LIS_localPet+1)+1
r1 = r - LIS_nss_halo_ind(n,LIS_localPet+1)+1
gid = LIS_domain(n)%gindex(c1,r1)
if(gid.ne.-1) then
if (gid .ne. -1) then
param_a(gid,l) = param_hires_2d(c,r)
endif
enddo
enddo
enddo

! read param_b
call LIS_verify(nf90_inq_varid(ftn,'cdf_param_b',param_b_id), &
call LIS_verify(nf90_inq_varid(ftn, 'cdf_param_b', param_b_id), &
'nf90_inq_varid failed for cdf_param_b in get_cdf_params')
call LIS_verify(nf90_get_var(ftn, param_b_id, param_hires, &
start=(/1,1,month/), count=(/ngrid,nlead,1/)),&
'nf90_get_var failed for cdf_param_b in get_cdf_params')

do l=1,nlead
do l = 1, nlead
! 1D -> 2D
do r=1,LIS_rc%gnr(n)
do c=1,LIS_rc%gnc(n)
param_hires_2d(c,r)=param_hires(c+(r-1)*LIS_rc%gnc(n),l)
do r = 1, LIS_rc%gnr(n)
do c = 1,LIS_rc%gnc(n)
param_hires_2d(c,r) = param_hires(c+(r-1)*LIS_rc%gnc(n),l)
enddo
enddo

!subsets the data for each processor's domain
nc = (LIS_ewe_halo_ind(n,LIS_localPet+1)-LIS_ews_halo_ind(n,LIS_localPet+1))+1
do r=LIS_nss_halo_ind(n,LIS_localPet+1),LIS_nse_halo_ind(n,LIS_localPet+1)
do c=LIS_ews_halo_ind(n,LIS_localPet+1),LIS_ewe_halo_ind(n,LIS_localPet+1)
c1 = c-LIS_ews_halo_ind(n,LIS_localPet+1)+1
r1 = r-LIS_nss_halo_ind(n,LIS_localPet+1)+1
do r = LIS_nss_halo_ind(n,LIS_localPet+1), LIS_nse_halo_ind(n,LIS_localPet+1)
do c = LIS_ews_halo_ind(n,LIS_localPet+1), LIS_ewe_halo_ind(n,LIS_localPet+1)
c1 = c - LIS_ews_halo_ind(n,LIS_localPet+1) + 1
r1 = r - LIS_nss_halo_ind(n,LIS_localPet+1) + 1
gid = LIS_domain(n)%gindex(c1,r1)
if(gid.ne.-1) then
if (gid.ne.-1) then
param_b(gid,l) = param_hires_2d(c,r)
endif
enddo
enddo
enddo

! read mean
call LIS_verify(nf90_inq_varid(ftn,'mean',mean_id), &
call LIS_verify(nf90_inq_varid(ftn, 'mean', mean_id), &
'nf90_inq_varid failed for mean in get_cdf_params')
call LIS_verify(nf90_get_var(ftn, mean_id, param_hires, &
start=(/1,1,month/), count=(/ngrid,nlead,1/)),&
'nf90_get_var failed for mean in get_cdf_params')

do l=1,nlead
do l = 1, nlead
! 1D -> 2D
do r=1,LIS_rc%gnr(n)
do c=1,LIS_rc%gnc(n)
param_hires_2d(c,r)=param_hires(c+(r-1)*LIS_rc%gnc(n),l)
do r = 1, LIS_rc%gnr(n)
do c = 1, LIS_rc%gnc(n)
param_hires_2d(c,r) = param_hires(c+(r-1)*LIS_rc%gnc(n),l)
enddo
enddo

!subsets the data for each processor's domain
nc = (LIS_ewe_halo_ind(n,LIS_localPet+1)-LIS_ews_halo_ind(n,LIS_localPet+1))+1
do r=LIS_nss_halo_ind(n,LIS_localPet+1),LIS_nse_halo_ind(n,LIS_localPet+1)
do c=LIS_ews_halo_ind(n,LIS_localPet+1),LIS_ewe_halo_ind(n,LIS_localPet+1)
c1 = c-LIS_ews_halo_ind(n,LIS_localPet+1)+1
r1 = r-LIS_nss_halo_ind(n,LIS_localPet+1)+1
do r = LIS_nss_halo_ind(n,LIS_localPet+1), LIS_nse_halo_ind(n,LIS_localPet+1)
do c = LIS_ews_halo_ind(n,LIS_localPet+1), LIS_ewe_halo_ind(n,LIS_localPet+1)
c1 = c - LIS_ews_halo_ind(n,LIS_localPet+1)+1
r1 = r - LIS_nss_halo_ind(n,LIS_localPet+1)+1
gid = LIS_domain(n)%gindex(c1,r1)
if(gid.ne.-1) then
if (gid.ne.-1) then
mean(gid,l) = param_hires_2d(c,r)
endif
enddo
enddo
enddo

! read std
call LIS_verify(nf90_inq_varid(ftn,'std',std_id), &
call LIS_verify(nf90_inq_varid(ftn, 'std', std_id), &
'nf90_inq_varid failed for std in get_cdf_params')
call LIS_verify(nf90_get_var(ftn, std_id, param_hires, &
start=(/1,1,month/), count=(/ngrid,nlead,1/)),&
'nf90_get_var failed for std in get_cdf_params')

do l=1,nlead
do l = 1, nlead
! 1D -> 2D
do r=1,LIS_rc%gnr(n)
do c=1,LIS_rc%gnc(n)
param_hires_2d(c,r)=param_hires(c+(r-1)*LIS_rc%gnc(n),l)
do r = 1, LIS_rc%gnr(n)
do c = 1, LIS_rc%gnc(n)
param_hires_2d(c,r) =param_hires(c+(r-1)*LIS_rc%gnc(n),l)
enddo
enddo

!subsets the data for each processor's domain
nc = (LIS_ewe_halo_ind(n,LIS_localPet+1)-LIS_ews_halo_ind(n,LIS_localPet+1))+1
do r=LIS_nss_halo_ind(n,LIS_localPet+1),LIS_nse_halo_ind(n,LIS_localPet+1)
do c=LIS_ews_halo_ind(n,LIS_localPet+1),LIS_ewe_halo_ind(n,LIS_localPet+1)
c1 = c-LIS_ews_halo_ind(n,LIS_localPet+1)+1
r1 = r-LIS_nss_halo_ind(n,LIS_localPet+1)+1
do r = LIS_nss_halo_ind(n,LIS_localPet+1), LIS_nse_halo_ind(n,LIS_localPet+1)
do c = LIS_ews_halo_ind(n,LIS_localPet+1), LIS_ewe_halo_ind(n,LIS_localPet+1)
c1 = c - LIS_ews_halo_ind(n,LIS_localPet+1) + 1
r1 = r - LIS_nss_halo_ind(n,LIS_localPet+1) + 1
gid = LIS_domain(n)%gindex(c1,r1)
if(gid.ne.-1) then
if (gid.ne.-1) then
std(gid,l) = param_hires_2d(c,r)
endif
enddo
Expand All @@ -202,7 +205,8 @@ subroutine get_cdf_params (n, fname, month, param_a, param_b, mean, std)

call LIS_verify(nf90_close(ftn),'failed to close in get_cdf_params')

write(LIS_logunit,*) 'Done reading MOGREPS-G bias correction parameters data '
write(LIS_logunit,*) &
'[INFO] Done reading MOGREPS-G bias correction parameters data '

end subroutine get_cdf_params

Loading

0 comments on commit 82f8083

Please sign in to comment.