New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
sbcapr.F90 in branches/UKMO/test_moci_test_suite_namelist_read/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/test_moci_test_suite_namelist_read/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90 @ 9366

Last change on this file since 9366 was 9366, checked in by andmirek, 6 years ago

#2050 first version. Compiled OK in moci test suite

File size: 10.3 KB
Line 
1MODULE sbcapr
2   !!======================================================================
3   !!                       ***  MODULE  sbcapr  ***
4   !! Surface module :   atmospheric pressure forcing
5   !!======================================================================
6   !! History :  3.3  !   2010-09  (J. Chanut, C. Bricaud, G. Madec)  Original code
7   !!----------------------------------------------------------------------
8   
9   !!----------------------------------------------------------------------
10   !!   sbc_apr        : read atmospheric pressure in netcdf files
11   !!----------------------------------------------------------------------
12   USE dom_oce         ! ocean space and time domain
13   USE sbc_oce         ! surface boundary condition
14   USE dynspg_oce      ! surface pressure gradient variables
15   USE phycst          ! physical constants
16   USE fldread         ! read input fields
17   USE in_out_manager  ! I/O manager
18   USE lib_fortran     ! distribued memory computing library
19   USE iom             ! IOM library
20   USE lib_mpp         ! MPP library
21   USE iom_def, ONLY : lwxios
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC   sbc_apr    ! routine called in sbcmod
27   PRIVATE  sio_namelist
28   
29   !                                !!* namsbc_apr namelist (Atmospheric PRessure) *
30   LOGICAL, PUBLIC ::   ln_apr_obc   !: inverse barometer added to OBC ssh data
31   LOGICAL, PUBLIC ::   ln_ref_apr   !: ref. pressure: global mean Patm (F) or a constant (F)
32   REAL(wp)        ::   rn_pref      !  reference atmospheric pressure   [N/m2]
33   LOGICAL         ::   ln_apr_sio   ! single processor read flag
34
35   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   ssh_ib    ! Inverse barometer now    sea surface height   [m]
36   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   ssh_ibb   ! Inverse barometer before sea surface height   [m]
37   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   apr       ! atmospheric pressure at kt                 [N/m2]
38   
39   REAL(wp) ::   tarea                ! whole domain mean masked ocean surface
40   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0)
41   
42   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read)
43
44   !! * Substitutions
45#  include "domzgr_substitute.h90"
46   !!----------------------------------------------------------------------
47   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
48   !! $Id$
49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
50   !!----------------------------------------------------------------------
51CONTAINS
52
53   SUBROUTINE sbc_apr( kt )
54      !!---------------------------------------------------------------------
55      !!                     ***  ROUTINE sbc_apr  ***
56      !!
57      !! ** Purpose :   read atmospheric pressure fields in netcdf files.
58      !!
59      !! ** Method  : - Read namelist namsbc_apr
60      !!              - Read Patm fields in netcdf files
61      !!              - Compute reference atmospheric pressure
62      !!              - Compute inverse barometer ssh
63      !! ** action  :   apr      : atmospheric pressure at kt
64      !!                ssh_ib   : inverse barometer ssh at kt
65      !!---------------------------------------------------------------------
66      INTEGER, INTENT(in)::   kt   ! ocean time step
67      !!
68      INTEGER            ::   ierror  ! local integer
69      INTEGER            ::   ios     ! Local integer output status for namelist read
70      !!
71      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files
72      TYPE(FLD_N)        ::  sn_apr   ! informations about the fields to be read
73      LOGICAL            ::  lxios_read ! read restart using XIOS?
74      !!
75      NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc
76      !!----------------------------------------------------------------------
77      !
78      !
79      !                                         ! -------------------- !
80      IF( kt == nit000 ) THEN                   ! First call kt=nit000 !
81         !                                      ! -------------------- !
82         ln_apr_sio = .FALSE.
83         IF(lwm) THEN
84            REWIND( numnam_ref )              ! Namelist namsbc_apr in reference namelist : File for atmospheric pressure forcing
85            READ  ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901)
86901         IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in reference namelist', lwm )
87            REWIND( numnam_cfg )              ! Namelist namsbc_apr in configuration namelist : File for atmospheric pressure forcing
88            READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 )
89902         IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist', lwm )
90         ENDIF
91
92         IF(lwm) WRITE ( numond, namsbc_apr )
93
94         CALL sio_namelist(cn_dir, sn_apr)
95         !
96         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst
97         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' )
98         !
99         CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' )
100                                ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1)   )
101         IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) )
102                                ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) )
103                                ALLOCATE( apr (jpi,jpj) )
104         !
105         IF(lwp) THEN                                 !* control print
106            WRITE(numout,*)
107            WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing'
108            WRITE(numout,*) '      ref. pressure: global mean Patm (T) or a constant (F)  ln_ref_apr = ', ln_ref_apr
109         ENDIF
110         !
111         IF( ln_ref_apr ) THEN                        !* Compute whole inner domain mean masked ocean surface
112            tarea = glob_sum( e1e2t(:,:) )
113            IF(lwp) WRITE(numout,*) '         Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2'
114         ELSE
115            IF(lwp) WRITE(numout,*) '         Reference Patm used : ', rn_pref, ' N/m2'
116         ENDIF
117         !
118         r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization
119         !
120         !                                            !* control check
121         IF ( ln_apr_obc  ) THEN
122            IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data'
123         ENDIF
124         IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts )   &
125            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' )
126         IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn   )   &
127            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' )
128      ENDIF
129
130      !                                         ! ========================== !
131      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    At each sbc time-step   !
132         !                                      ! ===========+++============ !
133         !
134         IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields
135         !
136         lspr = ln_apr_sio
137         CALL fld_read( kt, nn_fsbc, sf_apr )               !* input Patm provided at kt + nn_fsbc/2
138         lspr = .false.
139         !
140         !                                                  !* update the reference atmospheric pressure (if necessary)
141         IF( ln_ref_apr )   rn_pref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea
142         !
143         !                                                  !* Patm related forcing at kt
144         ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau    ! equivalent ssh (inverse barometer)
145         apr   (:,:) =     sf_apr(1)%fnow(:,:,1)                        ! atmospheric pressure
146         !
147         CALL iom_put( "ssh_ib", ssh_ib )                   !* output the inverse barometer ssh
148      ENDIF
149
150      !                                         ! ---------------------------------------- !
151      IF( kt == nit000 ) THEN                   !   set the forcing field at nit000 - 1    !
152         !                                      ! ---------------------------------------- !
153         !                                            !* Restart: read in restart file
154         IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN
155            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file'
156            CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb, lrxios = lxios_read )   ! before inv. barometer ssh
157            !
158         ELSE                                         !* no restart: set from nit000 values
159            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb set to nit000 values'
160            ssh_ibb(:,:) = ssh_ib(:,:)
161         ENDIF
162      ENDIF
163      !                                         ! ---------------------------------------- !
164      IF( lrst_oce ) THEN                       !      Write in the ocean restart file     !
165         !                                      ! ---------------------------------------- !
166         IF(lwp) WRITE(numout,*)
167         IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp
168         IF(lwp) WRITE(numout,*) '~~~~'
169         IF( lwxios ) CALL iom_swap(      wxios_context          )
170         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib, lxios = lwxios )
171         IF( lwxios ) CALL iom_swap(      cxios_context          )
172      ENDIF
173      !
174   END SUBROUTINE sbc_apr
175
176   SUBROUTINE sio_namelist(cd_dir, sd_apr)
177     !!---------------------------------------------------------------------
178     !!                   ***  ROUTINE sio_namelist  ***
179     !!                     
180     !! ** Purpose :   Broadcast namelist variables read by procesor lwm
181     !!
182     !! ** Method  :   use lib_mpp
183     !!----------------------------------------------------------------------
184      CHARACTER(len=100) ::  cd_dir   ! Root directory for location of ssr files
185      TYPE(FLD_N)        ::  sd_apr   ! informations about the fields to be read
186
187#if defined key_mpp_mpi
188      CALL mpp_bcast(cd_dir, 100)
189      CALL fld_n_bcast(sd_apr)
190      CALL mpp_bcast(ln_ref_apr)
191      CALL mpp_bcast(rn_pref)
192      CALL mpp_bcast(ln_apr_obc)
193#endif
194   END SUBROUTINE sio_namelist
195     
196   !!======================================================================
197END MODULE sbcapr
Note: See TracBrowser for help on using the repository browser.