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

source: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90 @ 5009

Last change on this file since 5009 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.
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      !                                         ! -------------------- !
76      IF( kt == nit000 ) THEN                   ! First call kt=nit000 !
77         !                                      ! -------------------- !
78         REWIND( numnam_ref )              ! Namelist namsbc_apr in reference namelist : File for atmospheric pressure forcing
79         READ  ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901)
80901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in reference namelist', lwp )
81
82         REWIND( numnam_cfg )              ! Namelist namsbc_apr in configuration namelist : File for atmospheric pressure forcing
83         READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 )
84902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist', lwp )
85         IF(lwm) WRITE ( numond, namsbc_apr )
86         !
87         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst
88         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' )
89         !
90         CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' )
91                                ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1)   )
92         IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) )
93                                ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) )
94                                ALLOCATE( apr (jpi,jpj) )
95         !
96         IF(lwp) THEN                                 !* control print
97            WRITE(numout,*)
98            WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing'
99            WRITE(numout,*) '      ref. pressure: global mean Patm (T) or a constant (F)  ln_ref_apr = ', ln_ref_apr
100         ENDIF
101         !
102         IF( ln_ref_apr ) THEN                        !* Compute whole inner domain mean masked ocean surface
103            tarea = glob_sum( e1e2t(:,:) )
104            IF(lwp) WRITE(numout,*) '         Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2'
105         ELSE
106            IF(lwp) WRITE(numout,*) '         Reference Patm used : ', rn_pref, ' N/m2'
107         ENDIF
108         !
109         r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization
110         !
111         !                                            !* control check
112         IF ( ln_apr_obc  ) THEN
113            IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data'
114         ENDIF
115         IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts )   &
116            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' )
117         IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn   )   &
118            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' )
119      ENDIF
120
121      !                                         ! ========================== !
122      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    At each sbc time-step   !
123         !                                      ! ===========+++============ !
124         !
125         IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields
126         !
127         CALL fld_read( kt, nn_fsbc, sf_apr )               !* input Patm provided at kt + nn_fsbc/2
128         !
129         !                                                  !* update the reference atmospheric pressure (if necessary)
130         IF( ln_ref_apr )   rn_pref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea
131         !
132         !                                                  !* Patm related forcing at kt
133         ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau    ! equivalent ssh (inverse barometer)
134         apr   (:,:) =     sf_apr(1)%fnow(:,:,1)                        ! atmospheric pressure
135         !
136         CALL iom_put( "ssh_ib", ssh_ib )                   !* output the inverse barometer ssh
137      ENDIF
138
139      !                                         ! ---------------------------------------- !
140      IF( kt == nit000 ) THEN                   !   set the forcing field at nit000 - 1    !
141         !                                      ! ---------------------------------------- !
142         !                                            !* Restart: read in restart file
143         IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN
144            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file'
145            CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh
146            !
147         ELSE                                         !* no restart: set from nit000 values
148            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb set to nit000 values'
149            ssh_ibb(:,:) = ssh_ib(:,:)
150         ENDIF
151      ENDIF
152      !                                         ! ---------------------------------------- !
153      IF( lrst_oce ) THEN                       !      Write in the ocean restart file     !
154         !                                      ! ---------------------------------------- !
155         IF(lwp) WRITE(numout,*)
156         IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp
157         IF(lwp) WRITE(numout,*) '~~~~'
158         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib )
159      ENDIF
160      !
161   END SUBROUTINE sbc_apr
162     
163   !!======================================================================
164END MODULE sbcapr
Note: See TracBrowser for help on using the repository browser.