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

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90 @ 2636

Last change on this file since 2636 was 2636, checked in by gm, 13 years ago

dynamic mem: #785 ; move ctl_stop & warn in lib_mpp to avoid a circular dependency + ctl_stop improvment
File size: 9.7 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 bdy_par         ! Unstructured boundary parameters
13   USE obc_par         ! open boundary condition parameters
14   USE dom_oce         ! ocean space and time domain
15   USE sbc_oce         ! surface boundary condition
16   USE dynspg_oce      ! surface pressure gradient variables
17   USE phycst          ! physical constants
18   USE fldread         ! read input fields
19   USE in_out_manager  ! I/O manager
20   USE lib_fortran     ! distribued memory computing library
21   USE iom             ! IOM library
22   USE lib_mpp         ! MPP library
23   USE restart         ! ocean restart
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   sbc_apr    ! routine called in sbcmod
29   
30   !                                         !!* namsbc_apr namelist (Atmospheric PRessure) *
31   LOGICAL, PUBLIC ::   ln_apr_obc = .FALSE.  !: inverse barometer added to OBC ssh data
32   LOGICAL, PUBLIC ::   ln_apr_bdy = .FALSE.  !: inverse barometer added to BDY ssh data
33   LOGICAL, PUBLIC ::   ln_ref_apr = .FALSE.  !: ref. pressure: global mean Patm (F) or a constant (F)
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) ::   rpref = 101000._wp   ! reference atmospheric pressure          [N/m2]
40   REAL(wp) ::   tarea                ! whole domain mean masked ocean surface
41   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0)
42   
43   TYPE(FLD), ALLOCATABLE, SAVE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read)
44
45   !! * Substitutions
46#  include "domzgr_substitute.h90"
47   !!----------------------------------------------------------------------
48   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
49   !! $Id: $
50   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
51   !!----------------------------------------------------------------------
52CONTAINS
53
54   SUBROUTINE sbc_apr( kt )
55      !!---------------------------------------------------------------------
56      !!                     ***  ROUTINE sbc_apr  ***
57      !!
58      !! ** Purpose :   read atmospheric pressure fields in netcdf files.
59      !!
60      !! ** Method  : - Read namelist namsbc_apr
61      !!              - Read Patm fields in netcdf files
62      !!              - Compute reference atmospheric pressure
63      !!              - Compute inverse barometer ssh
64      !! ** action  :   apr      : atmospheric pressure at kt
65      !!                ssh_ib   : inverse barometer ssh at kt
66      !!---------------------------------------------------------------------
67      INTEGER, INTENT(in)::   kt   ! ocean time step
68      !!
69      INTEGER            ::   ierror  ! local integer
70      REAL(wp)           ::   zpref   ! local scalar
71      !!
72      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files
73      TYPE(FLD_N)        ::  sn_apr   ! informations about the fields to be read
74      !!
75      NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr
76      !!----------------------------------------------------------------------
77      !
78      !
79      !                                         ! -------------------- !
80      IF( kt == nit000 ) THEN                   ! First call kt=nit000 !
81         !                                      ! -------------------- !
82         !                                            !* set file information (default values)
83         ! ... default values (NB: frequency positive => hours, negative => months)
84         !            !   file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
85         !            !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
86         sn_apr = FLD_N( 'patm'  ,    24     ,  'patm'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''       )
87         cn_dir  = './'          ! directory in which the Patm data are
88
89         REWIND( numnam )                             !* read in namlist namsbc_apr
90         READ  ( numnam, namsbc_apr ) 
91         !
92         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst
93         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' )
94         !
95         CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' )
96                                ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1)   )
97         IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) )
98                                ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) )
99                                ALLOCATE( apr (jpi,jpj) )
100         !
101         IF(lwp) THEN                                 !* control print
102            WRITE(numout,*)
103            WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing'
104            WRITE(numout,*) '      ref. pressure: global mean Patm (T) or a constant (F)  ln_ref_apr = ', ln_ref_apr
105         ENDIF
106         !
107         IF( ln_ref_apr ) THEN                        !* Compute whole inner domain mean masked ocean surface
108            tarea = glob_sum( e1t(:,:) * e2t(:,:) )
109            IF(lwp) WRITE(numout,*) '         Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2'
110         ELSE
111            IF(lwp) WRITE(numout,*) '         Reference Patm used : ', rpref, ' N/m2'
112         ENDIF
113         !
114         r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization
115         !
116         !                                            !* control check
117         IF( ln_apr_obc .OR. ln_apr_bdy   )   &
118            CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC or BDY ssh data not yet implemented ' )
119         IF( ln_apr_obc .AND. .NOT. lk_obc )   &
120            CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_obc' )
121         IF( ln_apr_bdy .AND. .NOT. lk_bdy )   &
122            CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_bdy' )
123         IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. lk_dynspg_ts )   &
124            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' )
125         IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. ln_apr_dyn   )   &
126            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' )
127      ENDIF
128
129      !                                         ! ========================== !
130      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    At each sbc time-step   !
131         !                                      ! ===========+++============ !
132         !
133         IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields
134         !
135         CALL fld_read( kt, nn_fsbc, sf_apr )               !* input Patm provided at kt + nn_fsbc/2
136         !
137         !                                                  !* update the reference atmospheric pressure (if necessary)
138         IF( ln_ref_apr )   rpref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1t(:,:) * e2t(:,:) ) / tarea
139         !
140         !                                                  !* Patm related forcing at kt
141         ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer)
142         apr   (:,:) =     sf_apr(1)%fnow(:,:,1)                        ! atmospheric pressure
143         !
144         CALL iom_put( "ssh_ib", ssh_ib )                   !* output the inverse barometer ssh
145      ENDIF
146
147      !                                         ! ---------------------------------------- !
148      IF( kt == nit000 ) THEN                   !   set the forcing field at nit000 - 1    !
149         !                                      ! ---------------------------------------- !
150         !                                            !* Restart: read in restart file
151         IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN
152            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file'
153            CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh
154            !
155         ELSE                                         !* no restart: set from nit000 values
156            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb set to nit000 values'
157            ssh_ibb(:,:) = ssh_ib(:,:)
158         ENDIF
159      ENDIF
160      !                                         ! ---------------------------------------- !
161      IF( lrst_oce ) THEN                       !      Write in the ocean restart file     !
162         !                                      ! ---------------------------------------- !
163         IF(lwp) WRITE(numout,*)
164         IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp
165         IF(lwp) WRITE(numout,*) '~~~~'
166         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib )
167      ENDIF
168      !
169   END SUBROUTINE sbc_apr
170     
171   !!======================================================================
172END MODULE sbcapr
Note: See TracBrowser for help on using the repository browser.