Skip to content

Commit

Permalink
changes requested by Mats Bensten
Browse files Browse the repository at this point in the history
  • Loading branch information
Mariana Vertenstein committed Jun 25, 2024
1 parent 13ddf51 commit 3d17def
Show file tree
Hide file tree
Showing 8 changed files with 333 additions and 350 deletions.
186 changes: 92 additions & 94 deletions cesm/mod_cesm.F90
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
! ------------------------------------------------------------------------------
! Copyright (C) 2011-2022 Mats Bentsen, Jerry Tjiputra, Jörg Schwinger
! Copyright (C) 2011-2024 Mats Bentsen, Jerry Tjiputra, Jörg Schwinger,
! Mariana Vertenstein
!
! This file is part of BLOM.
!
Expand Down Expand Up @@ -41,6 +42,7 @@ module mod_cesm
#ifdef HAMOCC
use mo_control_bgc, only: use_bromo
#endif
use mod_ifdefs, only: use_DIAG

implicit none
private
Expand Down Expand Up @@ -157,12 +159,8 @@ subroutine getfrc_cesm
! Interpolate CESM forcing fields.
! ---------------------------------------------------------------------------

#define DIAG
#undef DIAG
#ifdef DIAG
use mod_nctools
use mod_dia, only : iotype
#endif

integer :: i, j, l
real(r8) :: w1, w2
Expand All @@ -175,7 +173,7 @@ subroutine getfrc_cesm
endif
w2 = 1._r8 - w1

!$omp parallel do private(l, i)
!$omp parallel do private(l, i)
do j = 1, jj
do l = 1, isp(j)
do i = max(1, ifp(j, l)), min(ii, ilp(j, l))
Expand Down Expand Up @@ -216,96 +214,96 @@ subroutine getfrc_cesm
enddo
enddo
enddo
!$omp end parallel do
!$omp end parallel do

#ifdef DIAG
call ncfopn('getfrc_cesm.nc', 'w', 'c', 1, iotype)
call ncdims('x', itdm)
call ncdims('y', jtdm)
call ncdefvar('ustarw_da', 'x y', ndouble, 8)
call ncdefvar('lip_da', 'x y', ndouble, 8)
call ncdefvar('sop_da', 'x y', ndouble, 8)
call ncdefvar('eva_da', 'x y', ndouble, 8)
call ncdefvar('rnf_da', 'x y', ndouble, 8)
call ncdefvar('rfi_da', 'x y', ndouble, 8)
call ncdefvar('fmltfz_da', 'x y', ndouble, 8)
call ncdefvar('sfl_da', 'x y', ndouble, 8)
call ncdefvar('swa_da', 'x y', ndouble, 8)
call ncdefvar('nsf_da', 'x y', ndouble, 8)
call ncdefvar('hmlt_da', 'x y', ndouble, 8)
call ncdefvar('slp_da', 'x y', ndouble, 8)
call ncdefvar('abswnd_da', 'x y', ndouble, 8)
call ncdefvar('ficem_da', 'x y', ndouble, 8)
call ncdefvar('lamult_da', 'x y', ndouble, 8)
call ncdefvar('lasl_da', 'x y', ndouble, 8)
call ncdefvar('ustokes_da', 'x y', ndouble, 8)
call ncdefvar('vstokes_da', 'x y', ndouble, 8)
call ncdefvar('atmco2_da', 'x y', ndouble, 8)
call ncdefvar('atmbrf_da', 'x y', ndouble, 8)
call ncdefvar('atmn2o_da', 'x y', ndouble, 8)
call ncdefvar('atmnh3_da', 'x y', ndouble, 8)
call ncdefvar('atmnoydep_da', 'x y', ndouble, 8)
call ncdefvar('atmnoydep_da', 'x y', ndouble, 8)
call ncdefvar('ztx_da', 'x y', ndouble, 8)
call ncdefvar('mty_da', 'x y', ndouble, 8)
call ncedef
if (use_DIAG) then
call ncfopn('getfrc_cesm.nc', 'w', 'c', 1, iotype)
call ncdims('x', itdm)
call ncdims('y', jtdm)
call ncdefvar('ustarw_da', 'x y', ndouble, 8)
call ncdefvar('lip_da', 'x y', ndouble, 8)
call ncdefvar('sop_da', 'x y', ndouble, 8)
call ncdefvar('eva_da', 'x y', ndouble, 8)
call ncdefvar('rnf_da', 'x y', ndouble, 8)
call ncdefvar('rfi_da', 'x y', ndouble, 8)
call ncdefvar('fmltfz_da', 'x y', ndouble, 8)
call ncdefvar('sfl_da', 'x y', ndouble, 8)
call ncdefvar('swa_da', 'x y', ndouble, 8)
call ncdefvar('nsf_da', 'x y', ndouble, 8)
call ncdefvar('hmlt_da', 'x y', ndouble, 8)
call ncdefvar('slp_da', 'x y', ndouble, 8)
call ncdefvar('abswnd_da', 'x y', ndouble, 8)
call ncdefvar('ficem_da', 'x y', ndouble, 8)
call ncdefvar('lamult_da', 'x y', ndouble, 8)
call ncdefvar('lasl_da', 'x y', ndouble, 8)
call ncdefvar('ustokes_da', 'x y', ndouble, 8)
call ncdefvar('vstokes_da', 'x y', ndouble, 8)
call ncdefvar('atmco2_da', 'x y', ndouble, 8)
call ncdefvar('atmbrf_da', 'x y', ndouble, 8)
call ncdefvar('atmn2o_da', 'x y', ndouble, 8)
call ncdefvar('atmnh3_da', 'x y', ndouble, 8)
call ncdefvar('atmnoydep_da', 'x y', ndouble, 8)
call ncdefvar('atmnoydep_da', 'x y', ndouble, 8)
call ncdefvar('ztx_da', 'x y', ndouble, 8)
call ncdefvar('mty_da', 'x y', ndouble, 8)
call ncedef

call ncwrtr('ustarw_da', 'x y', ustarw_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('lip_da', 'x y', lip_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('sop_da', 'x y', sop_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('eva_da', 'x y', eva_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('rnf_da', 'x y', rnf_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('rfi_da', 'x y', rfi_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('fmltfz_da', 'x y', fmltfz_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('sfl_da', 'x y', sfl_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('swa_da', 'x y', swa_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('nsf_da', 'x y', nsf_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('hmlt_da', 'x y', hmlt_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('slp_da', 'x y', slp_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('abswnd_da', 'x y', abswnd_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('ficem_da', 'x y', ficem_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('lamult_da', 'x y', lamult_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('lasl_da', 'x y', lasl_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('ustokes_da', 'x y', ustokes_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('vstokes_da', 'x y', vstokes_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('atmco2_da', 'x y', atmco2_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('atmbrf_da', 'x y', atmbrf_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('atmn2o_da', 'x y', atmn2o_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('atmnh3_da', 'x y', atmnh3_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('atmnhxdep_da', 'x y', atmnhxdep_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('atmnoydep_da', 'x y', atmnoydep_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('ztx_da', 'x y', ztx_da(1 - nbdy, 1 - nbdy, l2ci), &
iu, 1, 1._r8, 0._r8, 8)
call ncwrtr('mty_da', 'x y', mty_da(1 - nbdy, 1 - nbdy, l2ci), &
iv, 1, 1._r8, 0._r8, 8)
call ncfcls
call xcstop('(getfrc_cesm)')
stop '(getfrc_cesm)'
#endif
call ncwrtr('ustarw_da', 'x y', ustarw_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('lip_da', 'x y', lip_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('sop_da', 'x y', sop_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('eva_da', 'x y', eva_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('rnf_da', 'x y', rnf_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('rfi_da', 'x y', rfi_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('fmltfz_da', 'x y', fmltfz_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('sfl_da', 'x y', sfl_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('swa_da', 'x y', swa_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('nsf_da', 'x y', nsf_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('hmlt_da', 'x y', hmlt_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('slp_da', 'x y', slp_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('abswnd_da', 'x y', abswnd_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('ficem_da', 'x y', ficem_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('lamult_da', 'x y', lamult_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('lasl_da', 'x y', lasl_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('ustokes_da', 'x y', ustokes_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('vstokes_da', 'x y', vstokes_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('atmco2_da', 'x y', atmco2_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('atmbrf_da', 'x y', atmbrf_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('atmn2o_da', 'x y', atmn2o_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('atmnh3_da', 'x y', atmnh3_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('atmnhxdep_da', 'x y', atmnhxdep_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('atmnoydep_da', 'x y', atmnoydep_da(1 - nbdy, 1 - nbdy, l2ci), &
ip, 1, 1._r8, 0._r8, 8)
call ncwrtr('ztx_da', 'x y', ztx_da(1 - nbdy, 1 - nbdy, l2ci), &
iu, 1, 1._r8, 0._r8, 8)
call ncwrtr('mty_da', 'x y', mty_da(1 - nbdy, 1 - nbdy, l2ci), &
iv, 1, 1._r8, 0._r8, 8)
call ncfcls
call xcstop('(getfrc_cesm)')
stop '(getfrc_cesm)'
end if

if (csdiag) then
if (mnproc == 1) then
Expand Down
52 changes: 22 additions & 30 deletions cesm/mod_geoenv_cesmextra.F90
View file
Original file line number Diff line number Diff line change
@@ -1,18 +1,18 @@
! ------------------------------------------------------------------------------
! Copyright (C) 2015-2020 Mats Bentsen

! Copyright (C) 2015-2024 Mats Bentsen, Mariana Vertenstein
!
! This file is part of BLOM.

!
! BLOM is free software: you can redistribute it and/or modify it under the
! terms of the GNU Lesser General Public License as published by the Free
! Software Foundation, either version 3 of the License, or (at your option)
! any later version.

!
! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY
! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
! more details.

!
! You should have received a copy of the GNU Lesser General Public License
! along with BLOM. If not, see <https://www.gnu.org/licenses/>.
! ------------------------------------------------------------------------------
Expand All @@ -34,34 +34,31 @@ module mod_geoenv_cesmextra

subroutine geoenv_cesmextra()

! --- ------------------------------------------------------------------
! --- Read additional grid parameters when configured for coupling to
! --- CESM
! --- ------------------------------------------------------------------
! ------------------------------------------------------------------
! Read additional grid parameters when configured for coupling to
! CESM
! ------------------------------------------------------------------

! Local variables
real, dimension(itdm,jtdm) :: tmpg
integer :: i,j,status,ncid,dimid,varid

! --- ------------------------------------------------------------------
! --- read grid information from grid file
! --- ------------------------------------------------------------------
! ------------------------------------------------------------------
! read grid information from grid file
! ------------------------------------------------------------------

if (mnproc == 1) then
write (lp,'(2a)') ' reading additional grid information from ', &
trim(grfile)
call flush(lp)
write (lp,'(2a)') ' reading additional grid information from ',trim(grfile)

! --- - open netcdf file
! - open netcdf file
status = nf90_open(grfile,nf90_nowrite,ncid)
if (status /= nf90_noerr) then
write(lp,'(4a)') ' nf90_open: ',trim(grfile),': ', &
nf90_strerror(status)
write(lp,'(4a)') ' nf90_open: ',trim(grfile),': ', nf90_strerror(status)
call xchalt('(geoenv_cesmextra)')
stop '(geoenv_cesmextra)'
end if

! --- - check dimensions
! check dimensions
status = nf90_inq_dimid(ncid,'x',dimid)
if (status /= nf90_noerr) then
write(lp,'(2a)') ' nf90_inq_dimid: x: ',nf90_strerror(status)
Expand All @@ -70,8 +67,7 @@ subroutine geoenv_cesmextra()
end if
status=nf90_inquire_dimension(ncid,dimid,len = i)
if (status /= nf90_noerr) then
write(lp,'(2a)') ' nf90_inquire_dimension: x: ', &
nf90_strerror(status)
write(lp,'(2a)') ' nf90_inquire_dimension: x: ', nf90_strerror(status)
call xchalt('(geoenv_cesmextra)')
stop '(geoenv_cesmextra)'
end if
Expand All @@ -83,8 +79,7 @@ subroutine geoenv_cesmextra()
end if
status=nf90_inquire_dimension(ncid,dimid,len = j)
if (status /= nf90_noerr) then
write(lp,'(2a)') ' nf90_inquire_dimension: y: ', &
nf90_strerror(status)
write(lp,'(2a)') ' nf90_inquire_dimension: y: ', nf90_strerror(status)
call xchalt('(geoenv_cesmextra)')
stop '(geoenv_cesmextra)'
end if
Expand All @@ -98,17 +93,15 @@ subroutine geoenv_cesmextra()
if (mnproc == 1) then
status = nf90_inq_varid(ncid,'cplmask',varid)
if (status /= nf90_noerr) then
write(lp,'(2a)') ' nf90_inq_varid: cplmask: ', &
nf90_strerror(status)
write(lp,'(2a)') ' nf90_inq_varid: cplmask: ', nf90_strerror(status)
call xchalt('(geoenv_cesmextra)')
stop '(geoenv_cesmextra)'
end if
end if
if (mnproc == 1) then
status = nf90_get_var(ncid,varid,tmpg)
if (status /= nf90_noerr) then
write(lp,'(2a)') ' nf90_get_var: cplmask: ', &
nf90_strerror(status)
write(lp,'(2a)') ' nf90_get_var: cplmask: ', nf90_strerror(status)
call xchalt('(geoenv_cesmextra)')
stop '(geoenv_cesmextra)'
end if
Expand All @@ -122,13 +115,12 @@ subroutine geoenv_cesmextra()
end do
!$omp end parallel do

! --- close grid information file
! close grid information file

if (mnproc == 1) then
status = nf90_close(ncid)
if (status /= nf90_noerr) then
write(lp,'(4a)') ' nf90_close: ',trim(grfile),': ', &
nf90_strerror(status)
write(lp,'(4a)') ' nf90_close: ',trim(grfile),': ', nf90_strerror(status)
call xchalt('(geoenv_cesmextra)')
stop '(geoenv_cesmextra)'
end if
Expand Down
16 changes: 8 additions & 8 deletions cesm/mod_sfcstr_cesm.F90
View file
Original file line number Diff line number Diff line change
@@ -1,18 +1,18 @@
! ------------------------------------------------------------------------------
! Copyright (C) 2015-2022 Mats Bentsen, Mehmet Ilicak

! Copyright (C) 2015-2022 Mats Bentsen, Mehmet Ilicak, Mariana Vertenstein
!
! This file is part of BLOM.

!
! BLOM is free software: you can redistribute it and/or modify it under the
! terms of the GNU Lesser General Public License as published by the Free
! Software Foundation, either version 3 of the License, or (at your option)
! any later version.

!
! BLOM is distributed in the hope that it will be useful, but WITHOUT ANY
! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
! FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
! more details.

!
! You should have received a copy of the GNU Lesser General Public License
! along with BLOM. If not, see <https://www.gnu.org/licenses/>.
! ------------------------------------------------------------------------------
Expand All @@ -33,9 +33,9 @@ module mod_sfcstr_cesm

subroutine sfcstr_cesm()

! --- ------------------------------------------------------------------
! --- Compute the surface stress. To be used when coupled to CESM
! --- ------------------------------------------------------------------
! ------------------------------------------------------------------
! Compute the surface stress. To be used when coupled to CESM
! ------------------------------------------------------------------

! Local variables
integer :: i,j,l
Expand Down
Loading

0 comments on commit 3d17def

Please sign in to comment.