Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
MODULE sbcapr
!!======================================================================
!! *** MODULE sbcapr ***
!! Surface module : atmospheric pressure forcing
!!======================================================================
!! History : 3.3 ! 2010-09 (J. Chanut, C. Bricaud, G. Madec) Original code
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!! sbc_apr : read atmospheric pressure in netcdf files
!!----------------------------------------------------------------------
USE dom_oce ! ocean space and time domain
USE sbc_oce ! surface boundary condition
USE phycst ! physical constants
!
USE fldread ! read input fields
USE in_out_manager ! I/O manager
USE lib_fortran ! distribued memory computing library
USE iom ! IOM library
USE lib_mpp ! MPP library
IMPLICIT NONE
PRIVATE
PUBLIC sbc_apr ! routine called in sbcmod
PUBLIC sbc_apr_init ! routine called in sbcmod
! !!* namsbc_apr namelist (Atmospheric PRessure) *
LOGICAL, PUBLIC :: ln_apr_obc = .false. !: inverse barometer added to OBC ssh data
LOGICAL, PUBLIC :: ln_ref_apr !: ref. pressure: global mean Patm (F) or a constant (F)
REAL(wp) :: rn_pref ! reference atmospheric pressure [N/m2]
REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: ssh_ib ! Inverse barometer now sea surface height [m]
REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: ssh_ibb ! Inverse barometer before sea surface height [m]
REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: apr ! atmospheric pressure at kt [N/m2]
REAL(wp) :: tarea ! whole domain mean masked ocean surface
REAL(wp) :: r1_grau ! = 1.e0 / (grav * rho0)
TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_apr ! structure of input fields (file informations, fields read)
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: sbcapr.F90 14072 2020-12-04 07:48:38Z laurent $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE sbc_apr_init
!!---------------------------------------------------------------------
!! *** ROUTINE sbc_apr ***
!!
!! ** Purpose : read atmospheric pressure fields in netcdf files.
!!
!! ** Method : - Read namelist namsbc_apr
!! - Read Patm fields in netcdf files
!! - Compute reference atmospheric pressure
!! - Compute inverse barometer ssh
!! ** action : apr : atmospheric pressure at kt
!! ssh_ib : inverse barometer ssh at kt
!!---------------------------------------------------------------------
INTEGER :: ierror ! local integer
INTEGER :: ios ! Local integer output status for namelist read
!!
CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files
TYPE(FLD_N) :: sn_apr ! informations about the fields to be read
!!
NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc
!!----------------------------------------------------------------------
READ ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901)
901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in reference namelist' )
READ ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 )
902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist' )
IF(lwm) WRITE ( numond, namsbc_apr )
!
ALLOCATE( sf_apr(1), STAT=ierror ) !* allocate and fill sf_sst (forcing structure) with sn_sst
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' )
!
CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' )
ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1) )
IF( sn_apr%ln_tint ) ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) )
ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) )
ALLOCATE( apr (jpi,jpj) )
!
IF( lwp )THEN !* control print
WRITE(numout,*)
WRITE(numout,*) ' Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing'
WRITE(numout,*) ' ref. pressure: global mean Patm (T) or a constant (F) ln_ref_apr = ', ln_ref_apr
ENDIF
!
IF( ln_ref_apr ) THEN !* Compute whole inner domain mean masked ocean surface
tarea = glob_sum( 'sbcapr', e1e2t(:,:) )
IF(lwp) WRITE(numout,*) ' Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2'
ELSE
IF(lwp) WRITE(numout,*) ' Reference Patm used : ', rn_pref, ' N/m2'
ENDIF
!
r1_grau = 1.e0 / (grav * rho0) !* constant for optimization
!
! !* control check
IF( ln_apr_obc ) THEN
IF(lwp) WRITE(numout,*) ' Inverse barometer added to OBC ssh data'
ENDIF
!jc: stop below should rather be a warning
IF( ln_apr_obc .AND. .NOT.ln_apr_dyn ) &
CALL ctl_warn( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' )
!
END SUBROUTINE sbc_apr_init
SUBROUTINE sbc_apr( kt )
!!---------------------------------------------------------------------
!! *** ROUTINE sbc_apr ***
!!
!! ** Purpose : read atmospheric pressure fields in netcdf files.
!!
!! ** Method : - Read namelist namsbc_apr
!! - Read Patm fields in netcdf files
!! - Compute reference atmospheric pressure
!! - Compute inverse barometer ssh
!! ** action : apr : atmospheric pressure at kt
!! ssh_ib : inverse barometer ssh at kt
!!---------------------------------------------------------------------
INTEGER, INTENT(in):: kt ! ocean time step
!
!!----------------------------------------------------------------------
! ! ========================== !
IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! At each sbc time-step !
! ! ===========+++============ !
!
IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields
!
CALL fld_read( kt, nn_fsbc, sf_apr ) !* input Patm provided at kt + nn_fsbc/2
!
! !* update the reference atmospheric pressure (if necessary)
IF( ln_ref_apr ) rn_pref = glob_sum( 'sbcapr', sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea
!
! !* Patm related forcing at kt
ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau ! equivalent ssh (inverse barometer)
apr (:,:) = sf_apr(1)%fnow(:,:,1) ! atmospheric pressure
!
CALL iom_put( "ssh_ib", ssh_ib ) !* output the inverse barometer ssh
ENDIF
! ! ---------------------------------------- !
IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 !
! ! ---------------------------------------- !
! !* Restart: read in restart file
IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN
IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file'
CALL iom_get( numror, jpdom_auto, 'ssh_ibb', ssh_ibb ) ! before inv. barometer ssh
!
ELSE !* no restart: set from nit000 values
IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb set to nit000 values'
ssh_ibb(:,:) = ssh_ib(:,:)
ENDIF
ENDIF
! ! ---------------------------------------- !
IF( lrst_oce ) THEN ! Write in the ocean restart file !
! ! ---------------------------------------- !
IF(lwp) WRITE(numout,*)
IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp
IF(lwp) WRITE(numout,*) '~~~~'
CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib )
ENDIF
!
END SUBROUTINE sbc_apr
!!======================================================================
END MODULE sbcapr