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 NEMO/branches/UKMO/r14075_cpl-pressure/src/OCE/SBC – NEMO

source: NEMO/branches/UKMO/r14075_cpl-pressure/src/OCE/SBC/sbcapr.F90 @ 15423

Last change on this file since 15423 was 15423, checked in by jcastill, 3 years ago

Changes compiling
File size: 10.1 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 phycst          ! physical constants
15   !
16   USE fldread         ! read input fields
17   USE in_out_manager  ! I/O manager
18   USE lib_fortran     ! distributed memory computing library
19   USE iom             ! IOM library
20   USE lib_mpp         ! MPP library
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   sbc_apr       ! routine called in sbcmod
26   PUBLIC   sbc_apr_init  ! routine called in sbcmod
27   
28   !                                          !!* namsbc_apr namelist (Atmospheric PRessure) *
29   LOGICAL, PUBLIC ::   ln_apr_obc = .false.   !: inverse barometer added to OBC ssh data
30   LOGICAL, PUBLIC ::   ln_ref_apr             !: ref. pressure: global mean Patm (F) or a constant (F)
31   REAL(wp),PUBLIC ::   rn_pref                !  reference atmospheric pressure   [N/m2]
32
33   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   ssh_ib    ! Inverse barometer now    sea surface height   [m]
34   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   ssh_ibb   ! Inverse barometer before sea surface height   [m]
35   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   apr       ! atmospheric pressure at kt                 [N/m2]
36   
37   REAL(wp), PUBLIC ::   tarea                 ! whole domain mean masked ocean surface
38   REAL(wp), PUBLIC ::   r1_grau               ! = 1.e0 / (grav * rau0)
39
40   LOGICAL, PUBLIC ::   cpl_mslp = .FALSE. ! Presure is passed via coupling
41   
42   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read)
43
44   !!----------------------------------------------------------------------
45   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
46   !! $Id$
47   !! Software governed by the CeCILL license (see ./LICENSE)
48   !!----------------------------------------------------------------------
49CONTAINS
50
51   SUBROUTINE sbc_apr_init
52      !!---------------------------------------------------------------------
53      !!                     ***  ROUTINE sbc_apr  ***
54      !!
55      !! ** Purpose :   read atmospheric pressure fields in netcdf files.
56      !!
57      !! ** Method  : - Read namelist namsbc_apr
58      !!              - Read Patm fields in netcdf files
59      !!              - Compute reference atmospheric pressure
60      !!              - Compute inverse barometer ssh
61      !! ** action  :   apr      : atmospheric pressure at kt
62      !!                ssh_ib   : inverse barometer ssh at kt
63      !!---------------------------------------------------------------------
64      INTEGER            ::   ierror  ! local integer
65      INTEGER            ::   ios     ! Local integer output status for namelist read
66      !!
67      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files
68      TYPE(FLD_N)        ::  sn_apr   ! informations about the fields to be read
69      LOGICAL            ::  lrxios   ! read restart using XIOS?
70      !!
71      NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc
72      !!----------------------------------------------------------------------
73      REWIND( numnam_ref )              ! Namelist namsbc_apr in reference namelist : File for atmospheric pressure forcing
74      READ  ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901)
75901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_apr in reference namelist' )
76
77      REWIND( numnam_cfg )              ! Namelist namsbc_apr in configuration namelist : File for atmospheric pressure forcing
78      READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 )
79902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist' )
80      IF(lwm) WRITE ( numond, namsbc_apr )
81      !
82      IF( .NOT. cpl_mslp ) THEN
83         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst
84         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' ) 
85         !
86         CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' )
87                                ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1)   )
88         IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) ) 
89      ENDIF
90                                ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) ) 
91                                ALLOCATE( apr (jpi,jpj) )
92      !
93      IF( lwp )THEN                                 !* control print
94         WRITE(numout,*)
95         IF( cpl_mslp ) THEN
96            WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing' 
97         ELSE   
98            WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric Pressure as extrenal forcing'   
99         ENDIF
100         WRITE(numout,*) '      ref. pressure: global mean Patm (T) or a constant (F)  ln_ref_apr = ', ln_ref_apr
101      ENDIF
102      !
103      IF( ln_ref_apr ) THEN                        !* Compute whole inner domain mean masked ocean surface
104         tarea = glob_sum( 'sbcapr', e1e2t(:,:) )
105         IF(lwp) WRITE(numout,*) '         Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2'
106      ELSE
107         IF(lwp) WRITE(numout,*) '         Reference Patm used : ', rn_pref, ' N/m2'
108      ENDIF
109      !
110      r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization
111      !
112      !                                            !* control check
113      IF ( ln_apr_obc  ) THEN
114         IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data'
115      ENDIF
116!jc: stop below should rather be a warning
117      IF( ln_apr_obc .AND. .NOT.ln_apr_dyn   )   &
118            CALL ctl_warn( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' )
119      !
120      IF( lwxios ) THEN
121         CALL iom_set_rstw_var_active('ssh_ibb')
122      ENDIF
123   END SUBROUTINE sbc_apr_init
124
125   SUBROUTINE sbc_apr( kt )
126      !!---------------------------------------------------------------------
127      !!                     ***  ROUTINE sbc_apr  ***
128      !!
129      !! ** Purpose :   read atmospheric pressure fields in netcdf files.
130      !!
131      !! ** Method  : - Read namelist namsbc_apr
132      !!              - Read Patm fields in netcdf files
133      !!              - Compute reference atmospheric pressure
134      !!              - Compute inverse barometer ssh
135      !! ** action  :   apr      : atmospheric pressure at kt
136      !!                ssh_ib   : inverse barometer ssh at kt
137      !!---------------------------------------------------------------------
138      INTEGER, INTENT(in)::   kt   ! ocean time step
139      !
140      !!----------------------------------------------------------------------
141
142      IF( .NOT. cpl_mslp ) THEN 
143                                                   ! ========================== ! 
144         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    At each sbc time-step   ! 
145            !                                      ! ===========+++============ !
146            IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields 
147            ! 
148            CALL fld_read( kt, nn_fsbc, sf_apr )               !* input Patm provided at kt + nn_fsbc/2 
149            ! 
150            !                                                  !* update the reference atmospheric pressure (if necessary) 
151            IF( ln_ref_apr )   rn_pref = glob_sum( 'sbcapr', sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea 
152            ! 
153            !                                                  !* Patm related forcing at kt 
154            ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau    ! equivalent ssh (inverse barometer) 
155            apr   (:,:) =     sf_apr(1)%fnow(:,:,1)                          ! atmospheric pressure 
156            ! 
157            CALL iom_put( "ssh_ib", ssh_ib )                   !* output the inverse barometer ssh
158         ENDIF
159
160         !                                         ! ---------------------------------------- ! 
161         IF( kt == nit000 ) THEN                   !   set the forcing field at nit000 - 1    ! 
162            !                                      ! ---------------------------------------- ! 
163            !                                            !* Restart: read in restart file 
164            IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN   
165               IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file' 
166               CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh 
167               ! 
168            ELSE                                         !* no restart: set from nit000 values 
169               IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb set to nit000 values' 
170               ssh_ibb(:,:) = ssh_ib(:,:) 
171            ENDIF 
172         ENDIF 
173         !                                         ! ---------------------------------------- ! 
174         IF( lrst_oce ) THEN                       !      Write in the ocean restart file     ! 
175            !                                      ! ---------------------------------------- ! 
176            IF(lwp) WRITE(numout,*) 
177            IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 
178            IF(lwp) WRITE(numout,*) '~~~~' 
179            CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib ) 
180         ENDIF
181         IF( lwxios ) CALL iom_swap(      cxios_context          )
182      ENDIF
183      !
184   END SUBROUTINE sbc_apr
185     
186   !!======================================================================
187END MODULE sbcapr
Note: See TracBrowser for help on using the repository browser.