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

source: branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90 @ 2797

Last change on this file since 2797 was 2797, checked in by davestorkey, 13 years ago

Delete BDY module and first implementation of new OBC module.

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