Skip to content

Commit

Permalink
revise external_ic.F90 and fv_nudge.F90 (NOAA-GFDL#68)
Browse files Browse the repository at this point in the history
  • Loading branch information
@binli2337 @laurenchilutti
binli2337 authored and laurenchilutti committed Feb 4, 2022
1 parent 2aa049c commit 32b44d9
Show file tree
Hide file tree
Showing 2 changed files with 35 additions and 125 deletions.
78 changes: 17 additions & 61 deletions tools/external_ic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1497,7 +1497,7 @@ subroutine get_ncep_ic( Atm, fv_domain, nq )
call ncep2fms(im, jm, lon, lat, wk2)
if( is_master() ) then
write(*,*) 'External_ic_mod: i_sst=', i_sst, ' j_sst=', j_sst
call pmaxmin( 'SST_ncep_fms', sst_ncep, i_sst, j_sst, 1.)
call pmaxmin( 'SST_ncep_fms', real(sst_ncep), i_sst, j_sst, 1.)
endif
#endif
endif !(read_ts)
Expand Down Expand Up @@ -3912,29 +3912,22 @@ subroutine pmaxmin( qname, a, im, jm, fac )
integer, intent(in):: im, jm
character(len=*) :: qname
integer i, j
class(*) a(im,jm)

real(r4_kind), dimension(:), allocatable :: qmin, qmax
real(r4_kind) pmax, pmin
class(*) fac ! multiplication factor
real(r8_kind), dimension(:), allocatable :: qmin8, qmax8
real(r8_kind) pmax8, pmin8

select type (fac)
type is (real(kind=r4_kind))
select type (a)
type is (real(kind=r4_kind))
allocate(qmax(jm), qmin(jm))
do j=1,jm
pmax = a(1,j)
pmin = a(1,j)
do i=2,im
pmax = max(pmax, a(i,j))
pmin = min(pmin, a(i,j))
enddo
qmax(j) = pmax
qmin(j) = pmin
real a(im,jm)

real qmin(jm), qmax(jm)
real pmax, pmin
real fac ! multiplication factor

do j=1,jm
pmax = a(1,j)
pmin = a(1,j)
do i=2,im
pmax = max(pmax, a(i,j))
pmin = min(pmin, a(i,j))
enddo
qmax(j) = pmax
qmin(j) = pmin
enddo
!
! Now find max/min of amax/amin
!
Expand All @@ -3944,45 +3937,8 @@ subroutine pmaxmin( qname, a, im, jm, fac )
pmax = max(pmax, qmax(j))
pmin = min(pmin, qmin(j))
enddo
deallocate(qmax, qmin)

write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac
class default
call mpp_error(FATAL,'==> Error in external_ic: unsupported types in pmaxmin')
end select

type is (real(kind=r8_kind))
select type (a)
type is (real(kind=r8_kind))
allocate(qmax8(jm), qmin8(jm))
do j=1,jm
pmax8 = a(1,j)
pmin8 = a(1,j)
do i=2,im
pmax8 = max(pmax8, a(i,j))
pmin8 = min(pmin8, a(i,j))
enddo
qmax8(j) = pmax8
qmin8(j) = pmin8
enddo
!
! Now find max/min of amax/amin
!
pmax8 = qmax8(1)
pmin8 = qmin8(1)
do j=2,jm
pmax8 = max(pmax8, qmax8(j))
pmin8 = min(pmin8, qmin8(j))
enddo
deallocate(qmax8, qmin8)

write(*,*) qname, ' max = ', pmax8*fac, ' min = ', pmin8*fac
class default
call mpp_error(FATAL,'==> Error in external_ic: unsupported types in pmaxmin')
end select
class default
call mpp_error(FATAL,'==> Error in external_ic: unsupported types in pmaxmin')
end select
write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac

end subroutine pmaxmin

Expand Down
82 changes: 18 additions & 64 deletions tools/fv_nudge.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1527,7 +1527,7 @@ subroutine get_ncep_analysis ( ps, u, v, t, q, zvir, ts, nfile, fname, bd )
#ifndef DYCORE_SOLO
! Perform interp to FMS SST format/grid
call ncep2fms( wk1 )
if(master) call pmaxmin( 'SST_ncep', sst_ncep, i_sst, j_sst, 1.)
if(master) call pmaxmin( 'SST_ncep', real(sst_ncep), i_sst, j_sst, 1.)
! if(nfile/=1 .and. master) call pmaxmin( 'SST_anom', sst_anom, i_sst, j_sst, 1.)
#endif
deallocate ( wk1 )
Expand Down Expand Up @@ -3394,36 +3394,27 @@ logical function leap_year(ny)

end function leap_year


subroutine pmaxmin( qname, a, imax, jmax, fac )

character(len=*) qname
integer imax, jmax
integer i, j
class(*) a(imax,jmax)
class(*) fac ! multiplication factor

real(r4_kind), dimension(:), allocatable :: qmin, qmax
real(r4_kind) pmax, pmin

real(r8_kind), dimension(:), allocatable :: qmin8, qmax8
real(r8_kind) pmax8, pmin8

select type (fac)
type is (real(kind=r4_kind))
select type (a)
type is (real(kind=r4_kind))
allocate(qmax(jmax), qmin(jmax))
do j=1,jmax
pmax = a(1,j)
pmin = a(1,j)
do i=2,imax
pmax = max(pmax, a(i,j))
pmin = min(pmin, a(i,j))
enddo
qmax(j) = pmax
qmin(j) = pmin
real a(imax,jmax)

real qmin(jmax), qmax(jmax)
real pmax, pmin
real fac ! multiplication factor

do j=1,jmax
pmax = a(1,j)
pmin = a(1,j)
do i=2,imax
pmax = max(pmax, a(i,j))
pmin = min(pmin, a(i,j))
enddo
qmax(j) = pmax
qmin(j) = pmin
enddo
!
! Now find max/min of amax/amin
!
Expand All @@ -3433,45 +3424,8 @@ subroutine pmaxmin( qname, a, imax, jmax, fac )
pmax = max(pmax, qmax(j))
pmin = min(pmin, qmin(j))
enddo
deallocate(qmax, qmin)

write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac
class default
call mpp_error(FATAL,'==> Error in fv_nudge: unsupported types in pmaxmin')
end select

type is (real(kind=r8_kind))
select type (a)
type is (real(kind=r8_kind))
allocate(qmax8(jmax), qmin8(jmax))
do j=1,jmax
pmax8 = a(1,j)
pmin8 = a(1,j)
do i=2,imax
pmax8 = max(pmax8, a(i,j))
pmin8 = min(pmin8, a(i,j))
enddo
qmax8(j) = pmax8
qmin8(j) = pmin8
enddo
!
! Now find max/min of amax/amin
!
pmax8 = qmax8(1)
pmin8 = qmin8(1)
do j=2,jmax
pmax8 = max(pmax8, qmax8(j))
pmin8 = min(pmin8, qmin8(j))
enddo
deallocate(qmax8, qmin8)

write(*,*) qname, ' max = ', pmax8*fac, ' min = ', pmin8*fac
class default
call mpp_error(FATAL,'==> Error in fv_nudge: unsupported types in pmaxmin')
end select
class default
call mpp_error(FATAL,'==> Error in fv_nudge: unsupported types in pmaxmin')
end select

write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac

end subroutine pmaxmin

Expand Down

0 comments on commit 32b44d9

Please sign in to comment.