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

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.
File size: 9.5 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 timing
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC   sbc_apr    ! routine called in sbcmod
27   
28   !                                !!* namsbc_apr namelist (Atmospheric PRessure) *
29   LOGICAL, PUBLIC ::   ln_apr_obc   !: 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)        ::   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) ::   tarea                ! whole domain mean masked ocean surface
38   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0)
39   
40   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read)
41
42   !! * Substitutions
43#  include "domzgr_substitute.h90"
44   !!----------------------------------------------------------------------
45   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
46   !! $Id$
47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
48   !!----------------------------------------------------------------------
49CONTAINS
50
51   SUBROUTINE sbc_apr( kt )
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, INTENT(in)::   kt   ! ocean time step
65      !!
66      INTEGER            ::   ierror  ! local integer
67      INTEGER            ::   ios     ! Local integer output status for namelist read
68      !!
69      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files
70      TYPE(FLD_N)        ::  sn_apr   ! informations about the fields to be read
71      !!
72      NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc
73      !!----------------------------------------------------------------------
74      !
75      !
76      !                                         ! -------------------- !
77      IF( kt == nit000 ) THEN                   ! First call kt=nit000 !
78         !                                      ! -------------------- !
79         REWIND( numnam_ref )              ! Namelist namsbc_apr in reference namelist : File for atmospheric pressure forcing
80         READ  ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901)
81901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in reference namelist', lwp )
82
83         REWIND( numnam_cfg )              ! Namelist namsbc_apr in configuration namelist : File for atmospheric pressure forcing
84         READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 )
85902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist', lwp )
86         IF(lwm .AND. nprint > 2) WRITE ( numond, namsbc_apr )
87         !
88         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst
89         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' )
90         !
91         CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' )
92                                ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1)   )
93         IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) )
94                                ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) )
95                                ALLOCATE( apr (jpi,jpj) )
96         !
97         IF(lwp) THEN                                 !* control print
98            WRITE(numout,*)
99            WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing'
100            WRITE(numout,*) '      ref. pressure: global mean Patm (T) or a constant (F)  ln_ref_apr = ', ln_ref_apr
101            IF(lflush) CALL flush(numout)
102         ENDIF
103         !
104         IF( ln_ref_apr ) THEN                        !* Compute whole inner domain mean masked ocean surface
105            tarea = glob_sum( e1e2t(:,:) )
106            IF(lwp) WRITE(numout,*) '         Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2'
107         ELSE
108            IF(lwp) WRITE(numout,*) '         Reference Patm used : ', rn_pref, ' N/m2'
109         ENDIF
110         !
111         r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization
112         !
113         !                                            !* control check
114         IF ( ln_apr_obc  ) THEN
115            IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data'
116         ENDIF
117         
118         IF(lwp .AND. lflush) CALL flush(numout)
119
120         IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts )   &
121            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' )
122         IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn   )   &
123            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' )
124      ENDIF
125
126      !                                         ! ========================== !
127      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    At each sbc time-step   !
128         !                                      ! ===========+++============ !
129         !
130         IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields
131         !
132         CALL fld_read( kt, nn_fsbc, sf_apr )               !* input Patm provided at kt + nn_fsbc/2
133         !
134         !                                                  !* update the reference atmospheric pressure (if necessary)
135         IF( ln_ref_apr )   rn_pref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea
136         !
137         !                                                  !* Patm related forcing at kt
138         ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau    ! equivalent ssh (inverse barometer)
139         apr   (:,:) =     sf_apr(1)%fnow(:,:,1)                        ! atmospheric pressure
140         !
141         CALL iom_put( "ssh_ib", ssh_ib )                   !* output the inverse barometer ssh
142      ENDIF
143
144      !                                         ! ---------------------------------------- !
145      IF( kt == nit000 ) THEN                   !   set the forcing field at nit000 - 1    !
146         !                                      ! ---------------------------------------- !
147         !                                            !* Restart: read in restart file
148         IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN
149            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file'
150            IF(nn_timing == 2)  CALL timing_start('iom_rstget')
151            CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh
152            IF(nn_timing == 2)  CALL timing_stop('iom_rstget')
153            !
154         ELSE                                         !* no restart: set from nit000 values
155            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb set to nit000 values'
156            ssh_ibb(:,:) = ssh_ib(:,:)
157         ENDIF
158 
159         IF(lwp .AND. lflush) CALL flush(numout)
160
161      ENDIF
162      !                                         ! ---------------------------------------- !
163      IF( lrst_oce ) THEN                       !      Write in the ocean restart file     !
164         !                                      ! ---------------------------------------- !
165         IF(lwp) WRITE(numout,*)
166         IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp
167         IF(lwp) WRITE(numout,*) '~~~~'
168         IF(lwp .AND. lflush) CALL flush(numout)
169         IF(nn_timing == 2)  CALL timing_start('iom_rstput')
170         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib )
171         IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
172      ENDIF
173      !
174   END SUBROUTINE sbc_apr
175     
176   !!======================================================================
177END MODULE sbcapr
Note: See TracBrowser for help on using the repository browser.