source: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/SAS/sbcssm.F90 @ 12808

Last change on this file since 12808 was 12377, checked in by acc, 10 months ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

  • Property svn:keywords set to Id
File size: 16.0 KB
Line 
1MODULE sbcssm
2   !!======================================================================
3   !!                       ***  MODULE  sbcssm  ***
4   !! Off-line : interpolation of the physical fields
5   !!======================================================================
6   !! History :  3.4  ! 2012-03 (S. Alderson)  original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   sbc_ssm_init  : initialization, namelist read, and SAVEs control
11   !!   sbc_ssm       : Interpolation of the fields
12   !!----------------------------------------------------------------------
13   USE oce            ! ocean dynamics and tracers variables
14   USE c1d            ! 1D configuration: lk_c1d
15   USE dom_oce        ! ocean domain: variables
16   USE zdf_oce        ! ocean vertical physics: variables
17   USE sbc_oce        ! surface module: variables
18   USE phycst         ! physical constants
19   USE eosbn2         ! equation of state - Brunt Vaisala frequency
20   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
21   USE zpshde         ! z-coord. with partial steps: horizontal derivatives
22   USE closea         ! for ln_closea
23   !
24   USE in_out_manager ! I/O manager
25   USE iom            ! I/O library
26   USE lib_mpp        ! distributed memory computing library
27   USE prtctl         ! print control
28   USE fldread        ! read input fields
29   USE timing         ! Timing
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC   sbc_ssm_init   ! called by sbc_init
35   PUBLIC   sbc_ssm        ! called by sbc
36
37   CHARACTER(len=100) ::   cn_dir        ! Root directory for location of ssm files
38   LOGICAL            ::   ln_3d_uve     ! specify whether input velocity data is 3D
39   LOGICAL            ::   ln_read_frq   ! specify whether we must read frq or not
40   
41   LOGICAL            ::   l_sasread     ! Ice intilisation: =T read a file ; =F anaytical initilaistion
42   LOGICAL            ::   l_initdone = .false.
43   INTEGER     ::   nfld_3d
44   INTEGER     ::   nfld_2d
45
46   INTEGER     ::   jf_tem         ! index of temperature
47   INTEGER     ::   jf_sal         ! index of salinity
48   INTEGER     ::   jf_usp         ! index of u velocity component
49   INTEGER     ::   jf_vsp         ! index of v velocity component
50   INTEGER     ::   jf_ssh         ! index of sea surface height
51   INTEGER     ::   jf_e3t         ! index of first T level thickness
52   INTEGER     ::   jf_frq         ! index of fraction of qsr absorbed in the 1st T level
53
54   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d  ! structure of input fields (file information, fields read)
55   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_2d  ! structure of input fields (file information, fields read)
56
57   !!----------------------------------------------------------------------
58   !! NEMO/SAS 4.0 , NEMO Consortium (2018)
59   !! $Id$
60   !! Software governed by the CeCILL license (see ./LICENSE)
61   !!----------------------------------------------------------------------
62CONTAINS
63
64   SUBROUTINE sbc_ssm( kt, Kbb, Kmm )
65      !!----------------------------------------------------------------------
66      !!                  ***  ROUTINE sbc_ssm  ***
67      !!
68      !! ** Purpose :  Prepares dynamics and physics fields from a NEMO run
69      !!               for an off-line simulation using surface processes only
70      !!
71      !! ** Method : calculates the position of data
72      !!             - interpolates data if needed
73      !!----------------------------------------------------------------------
74      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
75      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
76                          ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90)
77      !
78      INTEGER  ::   ji, jj     ! dummy loop indices
79      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation
80      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation
81      !!----------------------------------------------------------------------
82      !
83      IF( ln_timing )   CALL timing_start( 'sbc_ssm')
84     
85      IF ( l_sasread ) THEN
86         IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d )      !==   read data at kt time step   ==!
87         IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==!
88         !
89         IF( ln_3d_uve ) THEN
90            IF( .NOT. ln_linssh ) THEN
91               e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor
92            ELSE
93               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor
94            ENDIF
95            ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
96            ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity
97         ELSE
98            IF( .NOT. ln_linssh ) THEN
99               e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor
100            ELSE
101               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor
102            ENDIF
103            ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
104            ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity
105         ENDIF
106         !
107         sst_m(:,:) = sf_ssm_2d(jf_tem)%fnow(:,:,1) * tmask(:,:,1)    ! temperature
108         sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1)    ! salinity
109         ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height
110         IF( ln_read_frq ) THEN
111            frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! solar penetration
112         ELSE
113            frq_m(:,:) = 1._wp
114         ENDIF
115      ELSE
116         sss_m(:,:) = 35._wp                             ! =35. to obtain a physical value for the freezing point
117         CALL eos_fzp( sss_m(:,:), sst_m(:,:) )          ! sst_m is set at the freezing point
118         ssu_m(:,:) = 0._wp
119         ssv_m(:,:) = 0._wp
120         ssh_m(:,:) = 0._wp
121         IF( .NOT. ln_linssh ) e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D
122         frq_m(:,:) = 1._wp                              !              - -
123         ssh  (:,:,Kmm) = 0._wp                              !              - -
124      ENDIF
125     
126      IF ( nn_ice == 1 ) THEN
127         ts(:,:,1,jp_tem,Kmm) = sst_m(:,:)
128         ts(:,:,1,jp_sal,Kmm) = sss_m(:,:)
129         ts(:,:,1,jp_tem,Kbb) = sst_m(:,:)
130         ts(:,:,1,jp_sal,Kbb) = sss_m(:,:)
131      ENDIF
132      uu (:,:,1,Kbb) = ssu_m(:,:)
133      vv (:,:,1,Kbb) = ssv_m(:,:)
134 
135      IF(sn_cfctl%l_prtctl) THEN            ! print control
136         CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m   - : ', mask1=tmask   )
137         CALL prt_ctl(tab2d_1=sss_m, clinfo1=' sss_m   - : ', mask1=tmask   )
138         CALL prt_ctl(tab2d_1=ssu_m, clinfo1=' ssu_m   - : ', mask1=umask   )
139         CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m   - : ', mask1=vmask   )
140         CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m   - : ', mask1=tmask   )
141         IF( .NOT.ln_linssh )   CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m   - : ', mask1=tmask   )
142         IF( ln_read_frq    )   CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m   - : ', mask1=tmask   )
143      ENDIF
144      !
145      IF( l_initdone ) THEN          !   Mean value at each nn_fsbc time-step   !
146         CALL iom_put( 'ssu_m', ssu_m )
147         CALL iom_put( 'ssv_m', ssv_m )
148         CALL iom_put( 'sst_m', sst_m )
149         CALL iom_put( 'sss_m', sss_m )
150         CALL iom_put( 'ssh_m', ssh_m )
151         IF( .NOT.ln_linssh )   CALL iom_put( 'e3t_m', e3t_m )
152         IF( ln_read_frq    )   CALL iom_put( 'frq_m', frq_m )
153      ENDIF
154      !
155      IF( ln_timing )   CALL timing_stop( 'sbc_ssm')
156      !
157   END SUBROUTINE sbc_ssm
158
159
160   SUBROUTINE sbc_ssm_init( Kbb, Kmm )
161      !!----------------------------------------------------------------------
162      !!                  ***  ROUTINE sbc_ssm_init  ***
163      !!
164      !! ** Purpose :   Initialisation of sea surface mean data     
165      !!----------------------------------------------------------------------
166      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices
167                          ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90)
168      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code
169      INTEGER  :: ifpr                               ! dummy loop indice
170      INTEGER  :: inum, idv, idimv, jpm              ! local integer
171      INTEGER  ::   ios                              ! Local integer output status for namelist read
172      !!
173      CHARACTER(len=100)                     ::  cn_dir       ! Root directory for location of core files
174      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_3d       ! array of namelist information on the fields to read
175      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_2d       ! array of namelist information on the fields to read
176      TYPE(FLD_N) ::   sn_tem, sn_sal                     ! information about the fields to be read
177      TYPE(FLD_N) ::   sn_usp, sn_vsp
178      TYPE(FLD_N) ::   sn_ssh, sn_e3t, sn_frq
179      !!
180      NAMELIST/namsbc_sas/ l_sasread, cn_dir, ln_3d_uve, ln_read_frq,   &
181         &                 sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq
182      !!----------------------------------------------------------------------
183      !
184      IF( ln_rstart .AND. nn_components == jp_iam_sas )   RETURN
185      !
186      IF(lwp) THEN
187         WRITE(numout,*)
188         WRITE(numout,*) 'sbc_ssm_init : sea surface mean data initialisation '
189         WRITE(numout,*) '~~~~~~~~~~~~ '
190      ENDIF
191      !
192      READ  ( numnam_ref, namsbc_sas, IOSTAT = ios, ERR = 901)
193901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_sas in reference namelist' )
194      READ  ( numnam_cfg, namsbc_sas, IOSTAT = ios, ERR = 902 )
195902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist' )
196      IF(lwm) WRITE ( numond, namsbc_sas )
197      !           
198      IF(lwp) THEN                              ! Control print
199         WRITE(numout,*) '   Namelist namsbc_sas'
200         WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread 
201         WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve
202         WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq
203      ENDIF
204      !
205      !! switch off stuff that isn't sensible with a standalone module
206      !! note that we need sbc_ssm called first in sbc
207      !
208      IF( ln_apr_dyn ) THEN
209         IF( lwp ) WRITE(numout,*) '         ==>>>   No atmospheric gradient needed with StandAlone Surface scheme'
210         ln_apr_dyn = .FALSE.
211      ENDIF
212      IF( ln_rnf ) THEN
213         IF( lwp ) WRITE(numout,*) '         ==>>>   No runoff needed with StandAlone Surface scheme'
214         ln_rnf = .FALSE.
215      ENDIF
216      IF( ln_ssr ) THEN
217         IF( lwp ) WRITE(numout,*) '         ==>>>   No surface relaxation needed with StandAlone Surface scheme'
218         ln_ssr = .FALSE.
219      ENDIF
220      IF( nn_fwb > 0 ) THEN
221         IF( lwp ) WRITE(numout,*) '         ==>>>   No freshwater budget adjustment needed with StandAlone Surface scheme'
222         nn_fwb = 0
223      ENDIF
224      IF( ln_closea ) THEN
225         IF( lwp ) WRITE(numout,*) '         ==>>>   No closed seas adjustment needed with StandAlone Surface scheme'
226         ln_closea = .false.
227      ENDIF
228     
229      !                 
230      IF( l_sasread ) THEN                       ! store namelist information in an array
231         !
232         !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and
233         !! when we have other 3d arrays that we need to read in
234         !! so if a new field is added i.e. jf_new, just give it the next integer in sequence
235         !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d,
236         !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,
237         !! and the rest of the logic should still work
238         !
239         jf_tem = 1   ;   jf_ssh = 3   ! default 2D fields index
240         jf_sal = 2   ;   jf_frq = 4   !
241         !
242         IF( ln_3d_uve ) THEN
243            jf_usp = 1   ;   jf_vsp = 2   ;   jf_e3t = 3     ! define 3D fields index
244            nfld_3d  = 2 + COUNT( (/.NOT.ln_linssh/) )       ! number of 3D fields to read
245            nfld_2d  = 3 + COUNT( (/ln_read_frq/) )          ! number of 2D fields to read
246         ELSE
247            jf_usp = 4   ;   jf_e3t = 6                      ! update 2D fields index
248            jf_vsp = 5   ;   jf_frq = 6 + COUNT( (/.NOT.ln_linssh/) )
249            !
250            nfld_3d  = 0                                     ! no 3D fields to read
251            nfld_2d  = 5 + COUNT( (/.NOT.ln_linssh/) ) + COUNT( (/ln_read_frq/) )    ! number of 2D fields to read
252         ENDIF
253         !
254         IF( nfld_3d > 0 ) THEN
255            ALLOCATE( slf_3d(nfld_3d), STAT=ierr )         ! set slf structure
256            IF( ierr > 0 ) THEN
257               CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' )   ;   RETURN
258            ENDIF
259            slf_3d(jf_usp) = sn_usp
260            slf_3d(jf_vsp) = sn_vsp
261            IF( .NOT.ln_linssh )   slf_3d(jf_e3t) = sn_e3t
262         ENDIF
263         !
264         IF( nfld_2d > 0 ) THEN
265            ALLOCATE( slf_2d(nfld_2d), STAT=ierr )         ! set slf structure
266            IF( ierr > 0 ) THEN
267               CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 2d structure' )   ;   RETURN
268            ENDIF
269            slf_2d(jf_tem) = sn_tem   ;   slf_2d(jf_sal) = sn_sal   ;   slf_2d(jf_ssh) = sn_ssh
270            IF( ln_read_frq )   slf_2d(jf_frq) = sn_frq
271            IF( .NOT. ln_3d_uve ) THEN
272               slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp
273               IF( .NOT.ln_linssh )   slf_2d(jf_e3t) = sn_e3t
274            ENDIF
275         ENDIF
276         !
277         ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false.
278         IF( nfld_3d > 0 ) THEN
279            ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure
280            IF( ierr > 0 ) THEN
281               CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf structure' )   ;   RETURN
282            ENDIF
283            DO ifpr = 1, nfld_3d
284                                            ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 )
285               IF( slf_3d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2)  , STAT=ierr1 )
286               IF( ierr0 + ierr1 > 0 ) THEN
287                  CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_3d array structure' )   ;   RETURN
288               ENDIF
289            END DO
290            !                                         ! fill sf with slf_i and control print
291            CALL fld_fill( sf_ssm_3d, slf_3d, cn_dir, 'sbc_ssm_init', '3D Data in file', 'namsbc_ssm' )
292         ENDIF
293         !
294         IF( nfld_2d > 0 ) THEN
295            ALLOCATE( sf_ssm_2d(nfld_2d), STAT=ierr )         ! set sf structure
296            IF( ierr > 0 ) THEN
297               CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf 2d structure' )   ;   RETURN
298            ENDIF
299            DO ifpr = 1, nfld_2d
300                                            ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 )
301               IF( slf_2d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 )
302               IF( ierr0 + ierr1 > 0 ) THEN
303                  CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_2d array structure' )   ;   RETURN
304               ENDIF
305            END DO
306            !
307            CALL fld_fill( sf_ssm_2d, slf_2d, cn_dir, 'sbc_ssm_init', '2D Data in file', 'namsbc_ssm' )
308         ENDIF
309         !
310         IF( nfld_3d > 0 )   DEALLOCATE( slf_3d, STAT=ierr )
311         IF( nfld_2d > 0 )   DEALLOCATE( slf_2d, STAT=ierr )
312         !
313      ENDIF
314      !
315      CALL sbc_ssm( nit000, Kbb, Kmm )   ! need to define ss?_m arrays used in iceistate
316      l_initdone = .TRUE.
317      !
318   END SUBROUTINE sbc_ssm_init
319
320   !!======================================================================
321END MODULE sbcssm
Note: See TracBrowser for help on using the repository browser.