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 @ 3358

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

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