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

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90 @ 3211

Last change on this file since 3211 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.
File size: 9.8 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, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read)
44
45   !! * Control permutation of array indices
46#  include "oce_ftrans.h90"
47#  include "dom_oce_ftrans.h90"
48#  include "sbc_oce_ftrans.h90"
49
50   !! * Substitutions
51#  include "domzgr_substitute.h90"
52   !!----------------------------------------------------------------------
53   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
54   !! $Id: $
55   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
56   !!----------------------------------------------------------------------
57CONTAINS
58
59   SUBROUTINE sbc_apr( kt )
60      !!---------------------------------------------------------------------
61      !!                     ***  ROUTINE sbc_apr  ***
62      !!
63      !! ** Purpose :   read atmospheric pressure fields in netcdf files.
64      !!
65      !! ** Method  : - Read namelist namsbc_apr
66      !!              - Read Patm fields in netcdf files
67      !!              - Compute reference atmospheric pressure
68      !!              - Compute inverse barometer ssh
69      !! ** action  :   apr      : atmospheric pressure at kt
70      !!                ssh_ib   : inverse barometer ssh at kt
71      !!---------------------------------------------------------------------
72      INTEGER, INTENT(in)::   kt   ! ocean time step
73      !!
74      INTEGER            ::   ierror  ! local integer
75      REAL(wp)           ::   zpref   ! local scalar
76      !!
77      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files
78      TYPE(FLD_N)        ::  sn_apr   ! informations about the fields to be read
79      !!
80      NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr
81      !!----------------------------------------------------------------------
82      !
83      !
84      !                                         ! -------------------- !
85      IF( kt == nit000 ) THEN                   ! First call kt=nit000 !
86         !                                      ! -------------------- !
87         !                                            !* set file information (default values)
88         ! ... default values (NB: frequency positive => hours, negative => months)
89         !            !   file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
90         !            !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
91         sn_apr = FLD_N( 'patm'  ,    24     ,  'patm'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''       )
92         cn_dir  = './'          ! directory in which the Patm data are
93
94         REWIND( numnam )                             !* read in namlist namsbc_apr
95         READ  ( numnam, namsbc_apr ) 
96         !
97         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst
98         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' )
99         !
100         CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' )
101                                ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1)   )
102         IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) )
103                                ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) )
104                                ALLOCATE( apr (jpi,jpj) )
105         !
106         IF(lwp) THEN                                 !* control print
107            WRITE(numout,*)
108            WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing'
109            WRITE(numout,*) '      ref. pressure: global mean Patm (T) or a constant (F)  ln_ref_apr = ', ln_ref_apr
110         ENDIF
111         !
112         IF( ln_ref_apr ) THEN                        !* Compute whole inner domain mean masked ocean surface
113            tarea = glob_sum( e1t(:,:) * e2t(:,:) )
114            IF(lwp) WRITE(numout,*) '         Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2'
115         ELSE
116            IF(lwp) WRITE(numout,*) '         Reference Patm used : ', rpref, ' N/m2'
117         ENDIF
118         !
119         r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization
120         !
121         !                                            !* control check
122         IF( ln_apr_obc .OR. ln_apr_bdy   )   &
123            CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC or BDY ssh data not yet implemented ' )
124         IF( ln_apr_obc .AND. .NOT. lk_obc )   &
125            CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_obc' )
126         IF( ln_apr_bdy .AND. .NOT. lk_bdy )   &
127            CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_bdy' )
128         IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. lk_dynspg_ts )   &
129            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' )
130         IF( ( ln_apr_obc .OR. ln_apr_bdy ) .AND. .NOT. ln_apr_dyn   )   &
131            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' )
132      ENDIF
133
134      !                                         ! ========================== !
135      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    At each sbc time-step   !
136         !                                      ! ===========+++============ !
137         !
138         IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields
139         !
140         CALL fld_read( kt, nn_fsbc, sf_apr )               !* input Patm provided at kt + nn_fsbc/2
141         !
142         !                                                  !* update the reference atmospheric pressure (if necessary)
143         IF( ln_ref_apr )   rpref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1t(:,:) * e2t(:,:) ) / tarea
144         !
145         !                                                  !* Patm related forcing at kt
146         ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer)
147         apr   (:,:) =     sf_apr(1)%fnow(:,:,1)                        ! atmospheric pressure
148         !
149         CALL iom_put( "ssh_ib", ssh_ib )                   !* output the inverse barometer ssh
150      ENDIF
151
152      !                                         ! ---------------------------------------- !
153      IF( kt == nit000 ) THEN                   !   set the forcing field at nit000 - 1    !
154         !                                      ! ---------------------------------------- !
155         !                                            !* Restart: read in restart file
156         IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN
157            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file'
158            CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh
159            !
160         ELSE                                         !* no restart: set from nit000 values
161            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb set to nit000 values'
162            ssh_ibb(:,:) = ssh_ib(:,:)
163         ENDIF
164      ENDIF
165      !                                         ! ---------------------------------------- !
166      IF( lrst_oce ) THEN                       !      Write in the ocean restart file     !
167         !                                      ! ---------------------------------------- !
168         IF(lwp) WRITE(numout,*)
169         IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp
170         IF(lwp) WRITE(numout,*) '~~~~'
171         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib )
172      ENDIF
173      !
174   END SUBROUTINE sbc_apr
175     
176   !!======================================================================
177END MODULE sbcapr
Note: See TracBrowser for help on using the repository browser.