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 trunk/NEMOGCM/NEMO/SAS_SRC – NEMO

source: trunk/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90 @ 4624

Last change on this file since 4624 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.
File size: 13.3 KB
Line 
1MODULE sbcssm
2   !!======================================================================
3   !!                       ***  MODULE  sbcssm  ***
4   !! Off-line : interpolation of the physical fields
5   !!======================================================================
6   !! History :
7   !!   NEMO         3.4  ! 2012-03 First version by S. Alderson
8   !!                     !         Heavily derived from Christian's dtadyn routine
9   !!                     !         in OFF_SRC
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   sbc_ssm_init : initialization, namelist read, and SAVEs control
14   !!   sbc_ssm      : Interpolation of the fields
15   !!----------------------------------------------------------------------
16   USE oce             ! ocean dynamics and tracers variables
17   USE c1d             ! 1D configuration: lk_c1d
18   USE dom_oce         ! ocean domain: variables
19   USE zdf_oce         ! ocean vertical physics: variables
20   USE sbc_oce         ! surface module: variables
21   USE phycst          ! physical constants
22   USE eosbn2          ! equation of state - Brunt Vaisala frequency
23   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
24   USE zpshde          ! z-coord. with partial steps: horizontal derivatives
25   USE in_out_manager  ! I/O manager
26   USE iom             ! I/O library
27   USE lib_mpp         ! distributed memory computing library
28   USE prtctl          ! print control
29   USE fldread         ! read input fields
30   USE timing          ! Timing
31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC   sbc_ssm_init   ! called by sbc_init
36   PUBLIC   sbc_ssm        ! called by sbc
37
38   CHARACTER(len=100)   ::   cn_dir     = './'    !: Root directory for location of ssm files
39   LOGICAL              ::   ln_3d_uv   = .true.  !: specify whether input velocity data is 3D
40   INTEGER  , SAVE      ::   nfld_3d
41   INTEGER  , SAVE      ::   nfld_2d
42
43   INTEGER  , PARAMETER ::   jpfld_3d = 4   ! maximum number of files to read
44   INTEGER  , PARAMETER ::   jpfld_2d = 1   ! maximum number of files to read
45   INTEGER  , SAVE      ::   jf_tem         ! index of temperature
46   INTEGER  , SAVE      ::   jf_sal         ! index of salinity
47   INTEGER  , SAVE      ::   jf_usp         ! index of u velocity component
48   INTEGER  , SAVE      ::   jf_vsp         ! index of v velocity component
49   INTEGER  , SAVE      ::   jf_ssh         ! index of sea surface height
50
51   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d  ! structure of input fields (file information, fields read)
52   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_2d  ! structure of input fields (file information, fields read)
53
54   !! * Substitutions
55#  include "domzgr_substitute.h90"
56#  include "vectopt_loop_substitute.h90"
57   !!----------------------------------------------------------------------
58   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
59   !! $Id: sbcssm.F90 3294 2012-01-28 16:44:18Z rblod $
60   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
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      !
75      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
76      !
77      INTEGER  ::   ji, jj     ! dummy loop indices
78      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation
79      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation
80      !!----------------------------------------------------------------------
81     
82      !
83      IF( nn_timing == 1 )  CALL timing_start( 'sbc_ssm')
84
85      IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d )      !==   read data at kt time step   ==!
86      IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==!
87      !
88      IF( ln_3d_uv ) THEN
89         ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
90         ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity
91      ELSE
92         ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
93         ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity
94      ENDIF
95      !
96      sst_m(:,:) = sf_ssm_2d(jf_tem)%fnow(:,:,1) * tmask(:,:,1)    ! temperature
97      sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1)    ! salinity
98      ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1)    ! sea surface height
99      !
100      tsn(:,:,1,jp_tem) = sst_m(:,:)
101      tsn(:,:,1,jp_sal) = sss_m(:,:)
102      IF ( nn_ice == 1 ) THEN
103         tsb(:,:,1,jp_tem) = sst_m(:,:)
104         tsb(:,:,1,jp_sal) = sss_m(:,:)
105      ENDIF
106      ub (:,:,1       ) = ssu_m(:,:)
107      vb (:,:,1       ) = ssv_m(:,:)
108
109      IF(ln_ctl) THEN                  ! print control
110         CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m   - : ', mask1=tmask, ovlap=1   )
111         CALL prt_ctl(tab2d_1=sss_m, clinfo1=' sss_m   - : ', mask1=tmask, ovlap=1   )
112         CALL prt_ctl(tab2d_1=ssu_m, clinfo1=' ssu_m   - : ', mask1=umask, ovlap=1   )
113         CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m   - : ', mask1=vmask, ovlap=1   )
114         CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m   - : ', mask1=tmask, ovlap=1   )
115      ENDIF
116      !
117      IF( nn_timing == 1 )  CALL timing_stop( 'sbc_ssm')
118      !
119   END SUBROUTINE sbc_ssm
120
121
122   SUBROUTINE sbc_ssm_init
123      !!----------------------------------------------------------------------
124      !!                  ***  ROUTINE sbc_ssm_init  ***
125      !!
126      !! ** Purpose :   Initialisation of the dynamical data     
127      !! ** Method  : - read the data namsbc_ssm namelist
128      !!
129      !! ** Action  : - read parameters
130      !!----------------------------------------------------------------------
131      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code
132      INTEGER  :: ifpr                               ! dummy loop indice
133      INTEGER  :: inum, idv, idimv, jpm              ! local integer
134      INTEGER  ::   ios                              ! Local integer output status for namelist read
135      !!
136      CHARACTER(len=100)                     ::  cn_dir       ! Root directory for location of core files
137      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_3d       ! array of namelist information on the fields to read
138      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::  slf_2d       ! array of namelist information on the fields to read
139      TYPE(FLD_N) :: sn_tem, sn_sal                     ! information about the fields to be read
140      TYPE(FLD_N) :: sn_usp, sn_vsp, sn_ssh
141      !
142      NAMELIST/namsbc_sas/cn_dir, ln_3d_uv, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh
143      !!----------------------------------------------------------------------
144     
145      REWIND( numnam_ref )              ! Namelist namsbc_sas in reference namelist : Input fields
146      READ  ( numnam_ref, namsbc_sas, IOSTAT = ios, ERR = 901)
147901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_sas in reference namelist', lwp )
148
149      REWIND( numnam_cfg )              ! Namelist namsbc_sas in configuration namelist : Input fields
150      READ  ( numnam_cfg, namsbc_sas, IOSTAT = ios, ERR = 902 )
151902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist', lwp )
152      IF(lwm) WRITE ( numond, namsbc_sas )
153
154      !                                         ! store namelist information in an array
155      !                                         ! Control print
156      IF(lwp) THEN
157         WRITE(numout,*)
158         WRITE(numout,*) 'sbc_sas : standalone surface scheme '
159         WRITE(numout,*) '~~~~~~~~~~~ '
160         WRITE(numout,*) '   Namelist namsbc_sas'
161         WRITE(numout,*)
162      ENDIF
163     
164      !
165      !! switch off stuff that isn't sensible with a standalone module
166      !! note that we need sbc_ssm called first in sbc
167      !
168      IF( ln_cpl ) THEN
169         IF( lwp ) WRITE(numout,*) 'Coupled mode not sensible with StandAlone Surface scheme'
170         ln_cpl = .FALSE.
171      ENDIF
172      IF( ln_apr_dyn ) THEN
173         IF( lwp ) WRITE(numout,*) 'No atmospheric gradient needed with StandAlone Surface scheme'
174         ln_apr_dyn = .FALSE.
175      ENDIF
176      IF( ln_dm2dc ) THEN
177         IF( lwp ) WRITE(numout,*) 'No diurnal cycle needed with StandAlone Surface scheme'
178         ln_dm2dc = .FALSE.
179      ENDIF
180      IF( ln_rnf ) THEN
181         IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme'
182         ln_rnf = .FALSE.
183      ENDIF
184      IF( ln_ssr ) THEN
185         IF( lwp ) WRITE(numout,*) 'No surface relaxation needed with StandAlone Surface scheme'
186         ln_ssr = .FALSE.
187      ENDIF
188      IF( nn_fwb > 0 ) THEN
189         IF( lwp ) WRITE(numout,*) 'No freshwater budget adjustment needed with StandAlone Surface scheme'
190         nn_fwb = 0
191      ENDIF
192      IF( nn_closea > 0 ) THEN
193         IF( lwp ) WRITE(numout,*) 'No closed seas adjustment needed with StandAlone Surface scheme'
194         nn_closea = 0
195      ENDIF
196
197      !
198      !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and
199      !! when we have other 3d arrays that we need to read in
200      !! so if a new field is added i.e. jf_new, just give it the next integer in sequence
201      !! for the corresponding dimension (currently if ln_3d_uv is true, 4 for 2d and 3 for 3d,
202      !! alternatively if ln_3d_uv is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,
203      !! and the rest of the logic should still work
204      !
205      jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3
206      !
207      IF( ln_3d_uv ) THEN
208         jf_usp = 1 ; jf_vsp = 2
209         nfld_3d  = 2
210         nfld_2d  = 3
211      ELSE
212         jf_usp = 4 ; jf_vsp = 5
213         nfld_3d  = 0
214         nfld_2d  = 5
215      ENDIF
216
217      IF( nfld_3d > 0 ) THEN
218         ALLOCATE( slf_3d(nfld_3d), STAT=ierr )         ! set slf structure
219         IF( ierr > 0 ) THEN
220            CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' )   ;   RETURN
221         ENDIF
222         IF( ln_3d_uv ) THEN
223            slf_3d(jf_usp) = sn_usp
224            slf_3d(jf_vsp) = sn_vsp
225         ENDIF
226      ENDIF
227
228      IF( nfld_2d > 0 ) THEN
229         ALLOCATE( slf_2d(nfld_2d), STAT=ierr )         ! set slf structure
230         IF( ierr > 0 ) THEN
231            CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 2d structure' )   ;   RETURN
232         ENDIF
233         slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh
234         IF( .NOT. ln_3d_uv ) THEN
235            slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp
236         ENDIF
237      ENDIF
238      !
239      IF( nfld_3d > 0 ) THEN
240         ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr )         ! set sf structure
241         IF( ierr > 0 ) THEN
242            CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf structure' )   ;   RETURN
243         ENDIF
244         DO ifpr = 1, nfld_3d
245                                       ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 )
246            IF( slf_3d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2)  , STAT=ierr1 )
247            IF( ierr0 + ierr1 > 0 ) THEN
248               CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_3d array structure' )   ;   RETURN
249            ENDIF
250         END DO
251         !                                         ! fill sf with slf_i and control print
252         CALL fld_fill( sf_ssm_3d, slf_3d, cn_dir, 'sbc_ssm_init', '3D Data in file', 'namsbc_ssm' )
253      ENDIF
254
255      IF( nfld_2d > 0 ) THEN
256         ALLOCATE( sf_ssm_2d(nfld_2d), STAT=ierr )         ! set sf structure
257         IF( ierr > 0 ) THEN
258            CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf 2d structure' )   ;   RETURN
259         ENDIF
260         DO ifpr = 1, nfld_2d
261                                       ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1)    , STAT=ierr0 )
262            IF( slf_2d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2)  , STAT=ierr1 )
263            IF( ierr0 + ierr1 > 0 ) THEN
264               CALL ctl_stop( 'sbc_ssm_init : unable to allocate sf_ssm_2d array structure' )   ;   RETURN
265            ENDIF
266         END DO
267         !
268         CALL fld_fill( sf_ssm_2d, slf_2d, cn_dir, 'sbc_ssm_init', '2D Data in file', 'namsbc_ssm' )
269      ENDIF
270      !
271      ! lim code currently uses surface temperature and salinity in tsn array for initialisation
272      ! and ub, vb arrays in ice dynamics
273      ! so allocate enough of arrays to use
274      !
275      ierr3 = 0
276      jpm = MAX(jp_tem, jp_sal)
277      ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 )
278      ALLOCATE( ub(jpi,jpj,1)     , STAT=ierr1 )
279      ALLOCATE( vb(jpi,jpj,1)     , STAT=ierr2 )
280      IF ( nn_ice == 1 ) ALLOCATE( tsb(jpi,jpj,1,jpm), STAT=ierr3 )
281      ierr = ierr0 + ierr1 + ierr2 + ierr3
282      IF( ierr > 0 ) THEN
283         CALL ctl_stop('sbc_ssm_init: unable to allocate surface arrays')
284      ENDIF
285      !
286      ! finally tidy up
287
288      IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr )
289      IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr )
290      !
291   END SUBROUTINE sbc_ssm_init
292
293   !!======================================================================
294END MODULE sbcssm
Note: See TracBrowser for help on using the repository browser.