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/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.
  • Property svn:keywords set to Id
File size: 9.0 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
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   sbc_apr    ! routine called in sbcmod
26   
27   !                                !!* namsbc_apr namelist (Atmospheric PRessure) *
28   LOGICAL, PUBLIC ::   ln_apr_obc   !: inverse barometer added to OBC ssh data
29   LOGICAL, PUBLIC ::   ln_ref_apr   !: ref. pressure: global mean Patm (F) or a constant (F)
30   REAL(wp)        ::   rn_pref      !  reference atmospheric pressure   [N/m2]
31
32   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   ssh_ib    ! Inverse barometer now    sea surface height   [m]
33   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   ssh_ibb   ! Inverse barometer before sea surface height   [m]
34   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   apr       ! atmospheric pressure at kt                 [N/m2]
35   
36   REAL(wp) ::   tarea                ! whole domain mean masked ocean surface
37   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0)
38   
39   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read)
40
41   !! * Substitutions
42#  include "domzgr_substitute.h90"
43   !!----------------------------------------------------------------------
44   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
45   !! $Id$
46   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
47   !!----------------------------------------------------------------------
48CONTAINS
49
50   SUBROUTINE sbc_apr( kt )
51      !!---------------------------------------------------------------------
52      !!                     ***  ROUTINE sbc_apr  ***
53      !!
54      !! ** Purpose :   read atmospheric pressure fields in netcdf files.
55      !!
56      !! ** Method  : - Read namelist namsbc_apr
57      !!              - Read Patm fields in netcdf files
58      !!              - Compute reference atmospheric pressure
59      !!              - Compute inverse barometer ssh
60      !! ** action  :   apr      : atmospheric pressure at kt
61      !!                ssh_ib   : inverse barometer ssh at kt
62      !!---------------------------------------------------------------------
63      INTEGER, INTENT(in)::   kt   ! ocean time step
64      !
65      INTEGER            ::   ierror  ! local integer
66      INTEGER            ::   ios     ! Local integer output status for namelist read
67      !!
68      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files
69      TYPE(FLD_N)        ::  sn_apr   ! informations about the fields to be read
70      !!
71      NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc
72      !!----------------------------------------------------------------------
73      !
74      !                                         ! -------------------- !
75      IF( kt == nit000 ) THEN                   ! First call kt=nit000 !
76         !                                      ! -------------------- !
77         REWIND( numnam_ref )              ! Namelist namsbc_apr in reference namelist : File for atmospheric pressure forcing
78         READ  ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901)
79901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in reference namelist', lwp )
80
81         REWIND( numnam_cfg )              ! Namelist namsbc_apr in configuration namelist : File for atmospheric pressure forcing
82         READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 )
83902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist', lwp )
84         IF(lwm) WRITE ( numond, namsbc_apr )
85         !
86         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst
87         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' )
88         !
89         CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' )
90                                ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1)   )
91         IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) )
92                                ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) )
93                                ALLOCATE( apr (jpi,jpj) )
94         !
95         IF(lwp) THEN                                 !* control print
96            WRITE(numout,*)
97            WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing'
98            WRITE(numout,*) '      ref. pressure: global mean Patm (T) or a constant (F)  ln_ref_apr = ', ln_ref_apr
99         ENDIF
100         !
101         IF( ln_ref_apr ) THEN                        !* Compute whole inner domain mean masked ocean surface
102            tarea = glob_sum( e1e2t(:,:) )
103            IF(lwp) WRITE(numout,*) '         Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2'
104         ELSE
105            IF(lwp) WRITE(numout,*) '         Reference Patm used : ', rn_pref, ' N/m2'
106         ENDIF
107         !
108         r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization
109         !
110         !                                            !* control check
111         IF ( ln_apr_obc  ) THEN
112            IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data'
113         ENDIF
114         IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts )   &
115            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' )
116         IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn   )   &
117            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' )
118      ENDIF
119
120      !                                         ! ========================== !
121      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    At each sbc time-step   !
122         !                                      ! ===========+++============ !
123         !
124         IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields
125         !
126         CALL fld_read( kt, nn_fsbc, sf_apr )               !* input Patm provided at kt + nn_fsbc/2
127         !
128         !                                                  !* update the reference atmospheric pressure (if necessary)
129         IF( ln_ref_apr )   rn_pref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea
130         !
131         !                                                  !* Patm related forcing at kt
132         ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau    ! equivalent ssh (inverse barometer)
133         apr   (:,:) =     sf_apr(1)%fnow(:,:,1)                        ! atmospheric pressure
134         !
135         CALL iom_put( "ssh_ib", ssh_ib )                   !* output the inverse barometer ssh
136      ENDIF
137
138      !                                         ! ---------------------------------------- !
139      IF( kt == nit000 ) THEN                   !   set the forcing field at nit000 - 1    !
140         !                                      ! ---------------------------------------- !
141         !                                            !* Restart: read in restart file
142         IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN
143            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file'
144            CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh
145            !
146         ELSE                                         !* no restart: set from nit000 values
147            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb set to nit000 values'
148            ssh_ibb(:,:) = ssh_ib(:,:)
149         ENDIF
150      ENDIF
151      !                                         ! ---------------------------------------- !
152      IF( lrst_oce ) THEN                       !      Write in the ocean restart file     !
153         !                                      ! ---------------------------------------- !
154         IF(lwp) WRITE(numout,*)
155         IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp
156         IF(lwp) WRITE(numout,*) '~~~~'
157         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib )
158      ENDIF
159      !
160   END SUBROUTINE sbc_apr
161     
162   !!======================================================================
163END MODULE sbcapr
Note: See TracBrowser for help on using the repository browser.