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.
sbcssm.F90 in NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/SAS – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/SAS/sbcssm.F90 @ 11671

Last change on this file since 11671 was 11671, checked in by acc, 5 years ago

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Final, non-substantive changes to complete this branch. These changes remove all REWIND statements on the old namelist fortran units (now character variables for internal files). These changes have been left until last since they are easily repeated via a script and it may be preferable to use the previous revision for merge purposes and reapply these last changes separately. This branch has been fully SETTE tested.
  • Property svn:keywords set to Id
File size: 15.6 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 )
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      !
76      INTEGER  ::   ji, jj     ! dummy loop indices
77      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation
78      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation
79      !!----------------------------------------------------------------------
80      !
81      IF( ln_timing )   CALL timing_start( 'sbc_ssm')
82     
83      IF ( l_sasread ) THEN
84         IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d )      !==   read data at kt time step   ==!
85         IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==!
86         !
87         IF( ln_3d_uve ) THEN
88            IF( .NOT. ln_linssh ) THEN
89               e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor
90            ELSE
91               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor
92            ENDIF
93            ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
94            ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity
95         ELSE
96            IF( .NOT. ln_linssh ) THEN
97               e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor
98            ELSE
99               e3t_m(:,:) = e3t_0(:,:,1)                                 ! vertical scale factor
100            ENDIF
101            ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
102            ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity
103         ENDIF
104         !
105         sst_m(:,:) = sf_ssm_2d(jf_tem)%fnow(:,:,1) * tmask(:,:,1)    ! temperature
106         sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1)    ! salinity
107         ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height
108         IF( ln_read_frq ) THEN
109            frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! solar penetration
110         ELSE
111            frq_m(:,:) = 1._wp
112         ENDIF
113      ELSE
114         sss_m(:,:) = 35._wp                             ! =35. to obtain a physical value for the freezing point
115         CALL eos_fzp( sss_m(:,:), sst_m(:,:) )          ! sst_m is set at the freezing point
116         ssu_m(:,:) = 0._wp
117         ssv_m(:,:) = 0._wp
118         ssh_m(:,:) = 0._wp
119         IF( .NOT. ln_linssh ) e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D
120         frq_m(:,:) = 1._wp                              !              - -
121         sshn (:,:) = 0._wp                              !              - -
122      ENDIF
123     
124      IF ( nn_ice == 1 ) THEN
125         tsn(:,:,1,jp_tem) = sst_m(:,:)
126         tsn(:,:,1,jp_sal) = sss_m(:,:)
127         tsb(:,:,1,jp_tem) = sst_m(:,:)
128         tsb(:,:,1,jp_sal) = sss_m(:,:)
129      ENDIF
130      ub (:,:,1) = ssu_m(:,:)
131      vb (:,:,1) = ssv_m(:,:)
132 
133      IF(ln_ctl) THEN                  ! print control
134         CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m   - : ', mask1=tmask   )
135         CALL prt_ctl(tab2d_1=sss_m, clinfo1=' sss_m   - : ', mask1=tmask   )
136         CALL prt_ctl(tab2d_1=ssu_m, clinfo1=' ssu_m   - : ', mask1=umask   )
137         CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m   - : ', mask1=vmask   )
138         CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m   - : ', mask1=tmask   )
139         IF( .NOT.ln_linssh )   CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m   - : ', mask1=tmask   )
140         IF( ln_read_frq    )   CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m   - : ', mask1=tmask   )
141      ENDIF
142      !
143      IF( l_initdone ) THEN          !   Mean value at each nn_fsbc time-step   !
144         CALL iom_put( 'ssu_m', ssu_m )
145         CALL iom_put( 'ssv_m', ssv_m )
146         CALL iom_put( 'sst_m', sst_m )
147         CALL iom_put( 'sss_m', sss_m )
148         CALL iom_put( 'ssh_m', ssh_m )
149         IF( .NOT.ln_linssh )   CALL iom_put( 'e3t_m', e3t_m )
150         IF( ln_read_frq    )   CALL iom_put( 'frq_m', frq_m )
151      ENDIF
152      !
153      IF( ln_timing )   CALL timing_stop( 'sbc_ssm')
154      !
155   END SUBROUTINE sbc_ssm
156
157
158   SUBROUTINE sbc_ssm_init
159      !!----------------------------------------------------------------------
160      !!                  ***  ROUTINE sbc_ssm_init  ***
161      !!
162      !! ** Purpose :   Initialisation of sea surface mean data     
163      !!----------------------------------------------------------------------
164      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code
165      INTEGER  :: ifpr                               ! dummy loop indice
166      INTEGER  :: inum, idv, idimv, jpm              ! local integer
167      INTEGER  ::   ios                              ! Local integer output status for namelist read
168      !!
169      CHARACTER(len=100)                     ::  cn_dir       ! Root directory for location of core files
170      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_3d       ! array of namelist information on the fields to read
171      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_2d       ! array of namelist information on the fields to read
172      TYPE(FLD_N) ::   sn_tem, sn_sal                     ! information about the fields to be read
173      TYPE(FLD_N) ::   sn_usp, sn_vsp
174      TYPE(FLD_N) ::   sn_ssh, sn_e3t, sn_frq
175      !!
176      NAMELIST/namsbc_sas/ l_sasread, cn_dir, ln_3d_uve, ln_read_frq,   &
177         &                 sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq
178      !!----------------------------------------------------------------------
179      !
180      IF( ln_rstart .AND. nn_components == jp_iam_sas )   RETURN
181      !
182      IF(lwp) THEN
183         WRITE(numout,*)
184         WRITE(numout,*) 'sbc_ssm_init : sea surface mean data initialisation '
185         WRITE(numout,*) '~~~~~~~~~~~~ '
186      ENDIF
187      !
188      READ  ( numnam_ref, namsbc_sas, IOSTAT = ios, ERR = 901)
189901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_sas in reference namelist' )
190      READ  ( numnam_cfg, namsbc_sas, IOSTAT = ios, ERR = 902 )
191902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist' )
192      IF(lwm) WRITE ( numond, namsbc_sas )
193      !           
194      IF(lwp) THEN                              ! Control print
195         WRITE(numout,*) '   Namelist namsbc_sas'
196         WRITE(numout,*) '      Initialisation using an input file                                 l_sasread   = ', l_sasread 
197         WRITE(numout,*) '      Are we supplying a 3D u,v and e3 field                             ln_3d_uve   = ', ln_3d_uve
198         WRITE(numout,*) '      Are we reading frq (fraction of qsr absorbed in the 1st T level)   ln_read_frq = ', ln_read_frq
199      ENDIF
200      !
201      !! switch off stuff that isn't sensible with a standalone module
202      !! note that we need sbc_ssm called first in sbc
203      !
204      IF( ln_apr_dyn ) THEN
205         IF( lwp ) WRITE(numout,*) '         ==>>>   No atmospheric gradient needed with StandAlone Surface scheme'
206         ln_apr_dyn = .FALSE.
207      ENDIF
208      IF( ln_rnf ) THEN
209         IF( lwp ) WRITE(numout,*) '         ==>>>   No runoff needed with StandAlone Surface scheme'
210         ln_rnf = .FALSE.
211      ENDIF
212      IF( ln_ssr ) THEN
213         IF( lwp ) WRITE(numout,*) '         ==>>>   No surface relaxation needed with StandAlone Surface scheme'
214         ln_ssr = .FALSE.
215      ENDIF
216      IF( nn_fwb > 0 ) THEN
217         IF( lwp ) WRITE(numout,*) '         ==>>>   No freshwater budget adjustment needed with StandAlone Surface scheme'
218         nn_fwb = 0
219      ENDIF
220      IF( ln_closea ) THEN
221         IF( lwp ) WRITE(numout,*) '         ==>>>   No closed seas adjustment needed with StandAlone Surface scheme'
222         ln_closea = .false.
223      ENDIF
224     
225      !                 
226      IF( l_sasread ) THEN                       ! store namelist information in an array
227         !
228         !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and
229         !! when we have other 3d arrays that we need to read in
230         !! so if a new field is added i.e. jf_new, just give it the next integer in sequence
231         !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d,
232         !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,
233         !! and the rest of the logic should still work
234         !
235         jf_tem = 1   ;   jf_ssh = 3   ! default 2D fields index
236         jf_sal = 2   ;   jf_frq = 4   !
237         !
238         IF( ln_3d_uve ) THEN
239            jf_usp = 1   ;   jf_vsp = 2   ;   jf_e3t = 3     ! define 3D fields index
240            nfld_3d  = 2 + COUNT( (/.NOT.ln_linssh/) )       ! number of 3D fields to read
241            nfld_2d  = 3 + COUNT( (/ln_read_frq/) )          ! number of 2D fields to read
242         ELSE
243            jf_usp = 4   ;   jf_e3t = 6                      ! update 2D fields index
244            jf_vsp = 5   ;   jf_frq = 6 + COUNT( (/.NOT.ln_linssh/) )
245            !
246            nfld_3d  = 0                                     ! no 3D fields to read
247            nfld_2d  = 5 + COUNT( (/.NOT.ln_linssh/) ) + COUNT( (/ln_read_frq/) )    ! number of 2D fields to read
248         ENDIF
249         !
250         IF( nfld_3d > 0 ) THEN
251            ALLOCATE( slf_3d(nfld_3d), STAT=ierr )         ! set slf structure
252            IF( ierr > 0 ) THEN
253               CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' )   ;   RETURN
254            ENDIF
255            slf_3d(jf_usp) = sn_usp
256            slf_3d(jf_vsp) = sn_vsp
257            IF( .NOT.ln_linssh )   slf_3d(jf_e3t) = sn_e3t
258         ENDIF
259         !
260         IF( nfld_2d > 0 ) THEN
261            ALLOCATE( slf_2d(nfld_2d), STAT=ierr )         ! set slf structure
262            IF( ierr > 0 ) THEN
263               CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 2d structure' )   ;   RETURN
264            ENDIF
265            slf_2d(jf_tem) = sn_tem   ;   slf_2d(jf_sal) = sn_sal   ;   slf_2d(jf_ssh) = sn_ssh
266            IF( ln_read_frq )   slf_2d(jf_frq) = sn_frq
267            IF( .NOT. ln_3d_uve ) THEN
268               slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp
269               IF( .NOT.ln_linssh )   slf_2d(jf_e3t) = sn_e3t
270            ENDIF
271         ENDIF
272         !
273         ierr1 = 0    ! default definition if slf_?d(ifpr)%ln_tint = .false.
274         IF( nfld_3d > 0 ) THEN
275            ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure
276            IF( ierr > 0 ) THEN
277               CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf structure' )   ;   RETURN
278            ENDIF
279            DO ifpr = 1, nfld_3d
280                                            ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 )
281               IF( slf_3d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2)  , STAT=ierr1 )
282               IF( ierr0 + ierr1 > 0 ) THEN
283                  CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_3d array structure' )   ;   RETURN
284               ENDIF
285            END DO
286            !                                         ! fill sf with slf_i and control print
287            CALL fld_fill( sf_ssm_3d, slf_3d, cn_dir, 'sbc_ssm_init', '3D Data in file', 'namsbc_ssm' )
288         ENDIF
289         !
290         IF( nfld_2d > 0 ) THEN
291            ALLOCATE( sf_ssm_2d(nfld_2d), STAT=ierr )         ! set sf structure
292            IF( ierr > 0 ) THEN
293               CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf 2d structure' )   ;   RETURN
294            ENDIF
295            DO ifpr = 1, nfld_2d
296                                            ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 )
297               IF( slf_2d(ifpr)%ln_tint )   ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 )
298               IF( ierr0 + ierr1 > 0 ) THEN
299                  CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_2d array structure' )   ;   RETURN
300               ENDIF
301            END DO
302            !
303            CALL fld_fill( sf_ssm_2d, slf_2d, cn_dir, 'sbc_ssm_init', '2D Data in file', 'namsbc_ssm' )
304         ENDIF
305         !
306         IF( nfld_3d > 0 )   DEALLOCATE( slf_3d, STAT=ierr )
307         IF( nfld_2d > 0 )   DEALLOCATE( slf_2d, STAT=ierr )
308         !
309      ENDIF
310      !
311      CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in iceistate
312      l_initdone = .TRUE.
313      !
314   END SUBROUTINE sbc_ssm_init
315
316   !!======================================================================
317END MODULE sbcssm
Note: See TracBrowser for help on using the repository browser.