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.
sbcsas.F90 in branches/2012/dev_r3322_NOCS09_SAS/NEMOGCM/NEMO/SAS_SRC – NEMO

source: branches/2012/dev_r3322_NOCS09_SAS/NEMOGCM/NEMO/SAS_SRC/sbcsas.F90 @ 3335

Last change on this file since 3335 was 3335, checked in by sga, 12 years ago

Branch dev_r3322_NOCS09_SAS: remove interior ocean allocation

add allocation of surface fields used by LIM codes.
File size: 9.5 KB
Line 
1MODULE sbcsas
2   !!======================================================================
3   !!                       ***  MODULE  sbcsas  ***
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_sas_init : initialization, namelist read, and SAVEs control
14   !!   sbc_sas      : 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_sas_init   ! called by opa.F90
36   PUBLIC   sbc_sas        ! called by step.F90
37
38   CHARACTER(len=100) ::   cn_dir     = './'    !: Root directory for location of sas files
39
40   INTEGER  , PARAMETER ::   jpfld = 4      ! maximum number of files to read
41   INTEGER  , SAVE      ::   jf_tem         ! index of temperature
42   INTEGER  , SAVE      ::   jf_sal         ! index of salinity
43   INTEGER  , SAVE      ::   jf_uwd         ! index of u-wind
44   INTEGER  , SAVE      ::   jf_vwd         ! index of v-wind
45
46   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sas  ! structure of input fields (file information, fields read)
47   !                                               !
48   INTEGER :: nrecprev_tem , nrecprev_uwd
49
50   !! * Substitutions
51#  include "domzgr_substitute.h90"
52#  include "vectopt_loop_substitute.h90"
53   !!----------------------------------------------------------------------
54   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
55   !! $Id: sbcsas.F90 3294 2012-01-28 16:44:18Z rblod $
56   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
57   !!----------------------------------------------------------------------
58CONTAINS
59
60   SUBROUTINE sbc_sas( kt )
61      !!----------------------------------------------------------------------
62      !!                  ***  ROUTINE sbc_sas  ***
63      !!
64      !! ** Purpose :  Prepares dynamics and physics fields from a NEMO run
65      !!               for an off-line simulation using surface processes only
66      !!
67      !! ** Method : calculates the position of data
68      !!             - interpolates data if needed
69      !!----------------------------------------------------------------------
70      !
71      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
72      !
73      INTEGER  ::   ji, jj     ! dummy loop indices
74      INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step
75      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation
76      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation
77      INTEGER  ::   iswap_tem, iswap_uwd    !
78      !!----------------------------------------------------------------------
79     
80      !
81      IF( nn_timing == 1 )  CALL timing_start( 'sbc_sas')
82      !
83      isecsbc = nsec_year + nsec1jan000 
84      !
85      IF( kt == nit000 ) THEN
86         nrecprev_tem = 0
87         nrecprev_uwd = 0
88      ELSE
89         nrecprev_tem = sf_sas(jf_tem)%nrec_a(2)
90         nrecprev_uwd = sf_sas(jf_uwd)%nrec_a(2)
91      ENDIF
92      !
93      CALL fld_read( kt, 1, sf_sas )      !==   read data at kt time step   ==!
94      !
95      sst_m(:,:) = sf_sas(jf_tem)%fnow(:,:,1) * tmask(:,:,1)    ! temperature
96      sss_m(:,:) = sf_sas(jf_sal)%fnow(:,:,1) * tmask(:,:,1)    ! salinity
97      !
98      ssu_m(:,:) = sf_sas(jf_uwd)%fnow(:,:,1) * umask(:,:,1)    ! u-velocity
99      ssv_m(:,:) = sf_sas(jf_vwd)%fnow(:,:,1) * vmask(:,:,1)    ! v-velocity
100      !
101      tsn(:,:,1,jp_tem) = sst_m(:,:)
102      tsn(:,:,1,jp_sal) = sss_m(:,:)
103      ub (:,:,1       ) = ssu_m(:,:)
104      vb (:,:,1       ) = ssv_m(:,:)
105
106      IF(ln_ctl) THEN                  ! print control
107         CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m   - : ', mask1=tmask, ovlap=1   )
108         CALL prt_ctl(tab2d_1=sss_m, clinfo1=' sss_m   - : ', mask1=tmask, ovlap=1   )
109         CALL prt_ctl(tab2d_1=ssu_m, clinfo1=' ssu_m   - : ', mask1=umask, ovlap=1   )
110         CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m   - : ', mask1=vmask, ovlap=1   )
111      ENDIF
112      !
113      IF( nn_timing == 1 )  CALL timing_stop( 'sbc_sas')
114      !
115   END SUBROUTINE sbc_sas
116
117
118   SUBROUTINE sbc_sas_init
119      !!----------------------------------------------------------------------
120      !!                  ***  ROUTINE sbc_sas_init  ***
121      !!
122      !! ** Purpose :   Initialisation of the dynamical data     
123      !! ** Method  : - read the data namsbc_sas namelist
124      !!
125      !! ** Action  : - read parameters
126      !!----------------------------------------------------------------------
127      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code
128      INTEGER  :: ifpr                               ! dummy loop indice
129      INTEGER  :: jfld                               ! dummy loop arguments
130      INTEGER  :: inum, idv, idimv, jpm              ! local integer
131      !!
132      CHARACTER(len=100)            ::  cn_dir   !   Root directory for location of core files
133      TYPE(FLD_N), DIMENSION(jpfld) ::  slf_d    ! array of namelist information on the fields to read
134      TYPE(FLD_N) :: sn_tem, sn_sal, sn_emp, sn_ice, sn_qsr, sn_qns  ! information about the fields to be read
135      TYPE(FLD_N) :: sn_wnd, sn_uwd, sn_vwd
136      !
137      NAMELIST/namsbc_sas/cn_dir, sn_tem, sn_sal, sn_emp, sn_ice, sn_qsr, sn_qns, &
138         &                sn_wnd, sn_uwd, sn_vwd
139
140      !!----------------------------------------------------------------------
141      !                                   ! ============
142      !                                   !   Namelist
143      !                                   ! ============
144      ! (NB: frequency positive => hours, negative => months)
145      !                !   file      ! frequency !  variable  ! time intep !  clim  ! 'yearly' or ! weights  ! rotation   !
146      !                !   name      !  (hours)  !   name     !   (T/F)    !  (T/F) !  'monthly'  ! filename ! pairs      !
147      sn_tem  = FLD_N( 'sas_grid_T' ,    120    , 'votemper' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
148      sn_sal  = FLD_N( 'sas_grid_T' ,    120    , 'vosaline' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
149      sn_uwd  = FLD_N( 'sas_grid_U' ,    120    , 'vozocrtx' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
150      sn_vwd  = FLD_N( 'sas_grid_V' ,    120    , 'vomecrty' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
151      !
152      REWIND( numnam )                          ! read in namlist namsbc_sas
153      READ  ( numnam, namsbc_sas )
154      !                                         ! store namelist information in an array
155      !                                         ! Control print
156      IF(lwp) THEN
157         WRITE(numout,*)
158         WRITE(numout,*) 'sbc_sas : offline dynamics '
159         WRITE(numout,*) '~~~~~~~ '
160         WRITE(numout,*) '   Namelist namsbc_sas'
161         WRITE(numout,*)
162      ENDIF
163      !
164      jf_tem = 1   ;   jf_sal = 2   ;  jf_uwd = 3   ;  jf_vwd = 4 
165      jfld  = 4
166      !
167      slf_d(jf_tem) = sn_tem   ;   slf_d(jf_sal) = sn_sal   
168      slf_d(jf_uwd) = sn_uwd   ;   slf_d(jf_vwd) = sn_vwd
169      !
170      ALLOCATE( sf_sas(jfld), STAT=ierr )         ! set sf structure
171      IF( ierr > 0 ) THEN
172         CALL ctl_stop( 'sbc_sas: unable to allocate sf structure' )   ;   RETURN
173      ENDIF
174      DO ifpr = 1, jfld
175                                   ALLOCATE( sf_sas(ifpr)%fnow(jpi,jpj,jpk)    , STAT=ierr0 )
176         IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_sas(ifpr)%fdta(jpi,jpj,jpk,2)  , STAT=ierr1 )
177         IF( ierr0 + ierr1 > 0 ) THEN
178            CALL ctl_stop( 'sbc_sas_init : unable to allocate sf_sas array structure' )   ;   RETURN
179         ENDIF
180      END DO
181      !                                         ! fill sf with slf_i and control print
182      CALL fld_fill( sf_sas, slf_d, cn_dir, 'sbc_sas_init', 'Data in file', 'namsbc_sas' )
183      !
184      ! lim code currently uses surface temperature and salinity in tsn array for initialisation
185      ! and ub, vb arrays in ice dynamics
186      ! so allocate enough of arrays to use
187      !
188      jpm = MAX(jp_tem, jp_sal)
189      ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 )
190      ALLOCATE( ub(jpi,jpj,1)     , STAT=ierr1 )
191      ALLOCATE( vb(jpi,jpj,1)     , STAT=ierr2 )
192      ierr = ierr0 + ierr1 + ierr2
193      IF( ierr > 0 ) THEN
194         CALL ctl_stop('sbc_sas_init: unable to allocate surface arrays')
195      ENDIF
196      !
197   END SUBROUTINE sbc_sas_init
198
199   !!======================================================================
200END MODULE sbcsas
Note: See TracBrowser for help on using the repository browser.