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.
dtatem.F90 in branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90 @ 4409

Last change on this file since 4409 was 4409, checked in by trackstand2, 10 years ago

Changes to allow jpk to be modified to deepest level within a subdomain. jpkorig holds original value.
  • Property svn:keywords set to Id
File size: 11.3 KB
RevLine 
[3]1MODULE dtatem
2   !!======================================================================
3   !!                     ***  MODULE  dtatem  ***
4   !! Ocean data  :  read ocean temperature data from monthly atlas data
5   !!=====================================================================
[2528]6   !! History :  OPA  ! 1991-03  ()  Original code
7   !!             -   ! 1992-07  (M. Imbard)
8   !!            8.0  ! 1999-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT
9   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
10   !!            3.3  ! 2010-10  (C. Bricaud, S. Masson)  use of fldread
11   !!----------------------------------------------------------------------
[3]12#if defined key_dtatem   ||   defined key_esopa
13   !!----------------------------------------------------------------------
14   !!   'key_dtatem'                              3D temperature data field
15   !!----------------------------------------------------------------------
16   !!   dta_tem      : read ocean temperature data
[473]17   !!---l-------------------------------------------------------------------
[3]18   USE oce             ! ocean dynamics and tracers
19   USE dom_oce         ! ocean space and time domain
[2715]20   USE phycst          ! physical constants
[2528]21   USE fldread         ! read input fields
[3]22   USE in_out_manager  ! I/O manager
[2715]23   USE lib_mpp         ! MPP library
[2528]24
[3]25   IMPLICIT NONE
26   PRIVATE
27
[2528]28   PUBLIC   dta_tem    ! called by step.F90 and inidta.F90
[3]29
[2715]30   LOGICAL , PUBLIC, PARAMETER                     ::   lk_dtatem = .TRUE. !: temperature data flag
31   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) ::   t_dta              !: temperature data at given time-step
[3]32
[2528]33   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tem      ! structure of input SST (file informations, fields read)
[3]34
[3211]35   !! * Control permutation of array indices
36#  include "dtatem_ftrans.h90"
37#  include "oce_ftrans.h90"
38#  include "dom_oce_ftrans.h90"
39
[3]40   !! * Substitutions
41#  include "domzgr_substitute.h90"
42   !!----------------------------------------------------------------------
[2715]43   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
[1152]44   !! $Id$
[2528]45   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]46   !!----------------------------------------------------------------------
47CONTAINS
48
49   SUBROUTINE dta_tem( kt )
50      !!----------------------------------------------------------------------
51      !!                   ***  ROUTINE dta_tem  ***
52      !!                   
53      !! ** Purpose :   Reads monthly temperature data
54      !!
55      !! ** Method  :   Read on unit numtdt the interpolated temperature
56      !!      onto the model grid.
57      !!      Data begin at january.
58      !!      The value is centered at the middle of month.
59      !!      In the opa model, kt=1 agree with january 1.
60      !!      At each time step, a linear interpolation is applied between
61      !!      two monthly values.
62      !!      Read on unit numtdt
63      !!
64      !! ** Action  :   define t_dta array at time-step kt
65      !!----------------------------------------------------------------------
[2715]66      INTEGER, INTENT( in ) ::   kt   ! ocean time-step
[2528]67      !
[2715]68      INTEGER ::   ji, jj, jk, jl, jkk       ! dummy loop indicies
69      INTEGER ::   ik, ierr, ierr0, ierr1, ierr2   ! local integers
[2528]70#if defined key_tradmp
[2715]71      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! local integers
[473]72#endif
[2528]73      REAL(wp)::   zl
74      REAL(wp), DIMENSION(jpk) ::   ztemdta            ! auxiliary array for interpolation
75      !
76      CHARACTER(len=100)       ::   cn_dir             ! Root directory for location of ssr files
77      TYPE(FLD_N)              ::   sn_tem
78      LOGICAL , SAVE           ::   linit_tem = .FALSE.
79      !!
80      NAMELIST/namdta_tem/   cn_dir, sn_tem
[3]81      !!----------------------------------------------------------------------
[2528]82 
83      ! 1. Initialization
[473]84      ! -----------------------
85     
[2528]86      IF( kt == nit000 .AND. (.NOT. linit_tem ) ) THEN
87
88         !                   ! set file information
89         cn_dir = './'       ! directory in which the model is executed
90         ! ... default values (NB: frequency positive => hours, negative => months)
91         !            !   file    ! frequency ! variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
92         !            !   name    !  (hours)  !  name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
93         sn_tem = FLD_N( 'temperature',  -1.  , 'votemper',  .false.   , .true.  ,  'yearly'   , ''       , ''       )
94
95         REWIND( numnam )          ! read in namlist namdta_tem
96         READ( numnam, namdta_tem ) 
97
98         IF(lwp) THEN              ! control print
99            WRITE(numout,*)
100            WRITE(numout,*) 'dta_tem : Temperature Climatology '
101            WRITE(numout,*) '~~~~~~~ '
102         ENDIF
[2715]103
104                                   ! Allocate temperature data array
[4409]105                                ALLOCATE( t_dta(jpi,jpj,jpkorig)           , STAT=ierr  )
[2715]106         IF( ierr > 0              )   CALL ctl_stop( 'STOP', 'dta_tem: unable to allocate t_dta array' )
107                                   ! Allocate sf_tem structure
108                                ierr2 = 0
[4409]109                                ALLOCATE( sf_tem(1)                        , STAT=ierr0 )
110                                ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkorig)  , STAT=ierr1 )
111         IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkorig,2), STAT=ierr2 )
[2715]112         IF( ierr0+ierr1+ierr2 > 0 )   CALL ctl_stop( 'STOP', 'dta_tem: unable to allocate sf_tem structure' )
[2528]113         !                         ! fill sf_tem with sn_tem and control print
114         CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' )
115         linit_tem = .TRUE.
116         !
[473]117      ENDIF
118     
119      ! 2. Read monthly file
120      ! -------------------
121         
[2528]122      CALL fld_read( kt, 1, sf_tem )
123       
124      IF( lwp .AND. kt == nit000 )THEN
125         WRITE(numout,*)
126         WRITE(numout,*) ' read Levitus temperature ok'
127         WRITE(numout,*)
128      ENDIF
[473]129         
[434]130#if defined key_tradmp
[2528]131      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      !  ORCA_R2 configuration
132         !
133         ij0 = 101   ;   ij1 = 109
134         ii0 = 141   ;   ii1 = 155
135         DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea
136            DO ji = mi0(ii0), mi1(ii1)
137               sf_tem(1)%fnow(ji,jj, 13:13 ) = sf_tem(1)%fnow(ji,jj, 13:13 ) - 0.20
138               sf_tem(1)%fnow(ji,jj, 14:15 ) = sf_tem(1)%fnow(ji,jj, 14:15 ) - 0.35 
139               sf_tem(1)%fnow(ji,jj, 16:25 ) = sf_tem(1)%fnow(ji,jj, 16:25 ) - 0.40
[473]140            END DO
[2528]141         END DO
142         !
143         IF( nn_cla == 1 ) THEN 
144            !                                         ! New temperature profile at Gibraltar
145            il0 = 138   ;   il1 = 138
146            ij0 = 101   ;   ij1 = 102
147            ii0 = 139   ;   ii1 = 139
148            DO jl = mi0(il0), mi1(il1)
149               DO jj = mj0(ij0), mj1(ij1)
150                  DO ji = mi0(ii0), mi1(ii1)
151                     sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:)
[473]152                  END DO
153               END DO
[2528]154            END DO
155            !                                         ! New temperature profile at Bab el Mandeb
156            il0 = 164   ;   il1 = 164
157            ij0 =  87   ;   ij1 =  88
158            ii0 = 161   ;   ii1 = 163
159            DO jl = mi0(il0), mi1(il1)
160               DO jj = mj0(ij0), mj1(ij1)
161                  DO ji = mi0(ii0), mi1(ii1)
162                     sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:)
[473]163                  END DO
[1273]164               END DO
[2528]165            END DO
166         ELSE
167            !                                         ! Reduced temperature at Red Sea
168            ij0 =  87   ;   ij1 =  96
169            ii0 = 148   ;   ii1 = 160
170            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0
171            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5
172            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0
173         ENDIF
[1273]174            !
[2528]175      ENDIF
[473]176#endif
177         
[3211]178#if defined key_z_first
179      !! DCSE_NEMO: Beware! These arrays will not be conformable after permuting indices of t_dta
180      DO jk = 1, jpk
181         DO jj = 1, jpj
182            DO ji = 1, jpi
183               t_dta(ji,jj,jk) = sf_tem(1)%fnow(ji,jj,jk) 
184            END DO
185         END DO
186      END DO
187#else
[2528]188      t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:) 
[3211]189#endif
190
[473]191         
[2528]192      IF( ln_sco ) THEN
193         DO jj = 1, jpj                  ! interpolation of temperatures
194            DO ji = 1, jpi
195               DO jk = 1, jpk
196                  zl=fsdept_0(ji,jj,jk)
197                  IF(zl < gdept_0(1))   ztemdta(jk) =  t_dta(ji,jj,1)
198                  IF(zl > gdept_0(jpk)) ztemdta(jk) =  t_dta(ji,jj,jpkm1) 
199                  DO jkk = 1, jpkm1
200                     IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN
201                        ztemdta(jk) = t_dta(ji,jj,jkk)                                 &
202                                  &    + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))  &
203                                  &    * (t_dta(ji,jj,jkk+1) - t_dta(ji,jj,jkk))
204                     ENDIF
[473]205                  END DO
206               END DO
[2528]207               DO jk = 1, jpkm1
208                  t_dta(ji,jj,jk) = ztemdta(jk)
209               END DO
210               t_dta(ji,jj,jpk) = 0.0
[473]211            END DO
[2528]212         END DO
[473]213           
[2528]214         IF( lwp .AND. kt == nit000 )THEN
215            WRITE(numout,*)
216            WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate'
217            WRITE(numout,*)
218         ENDIF
[473]219           
[2528]220      ELSE
221         !                                  ! Mask
222         t_dta(:,:,:  ) = t_dta(:,:,:) * tmask(:,:,:)
223         t_dta(:,:,jpk) = 0.
224         IF( ln_zps ) THEN                ! z-coord. with partial steps
225            DO jj = 1, jpj                ! interpolation of temperature at the last level
226               DO ji = 1, jpi
227                  ik = mbkt(ji,jj)
228                  IF( ik > 1 ) THEN
229                     zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
230                     t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1)
231                  ENDIF
232               END DO
[473]233            END DO
234         ENDIF
[2528]235         !
236      ENDIF
[473]237         
[2528]238      IF( lwp .AND. kt == nit000 ) THEN
239         WRITE(numout,*) ' temperature Levitus '
240         WRITE(numout,*)
241         WRITE(numout,*)'  level = 1'
242         CALL prihre( t_dta(:,:,1    ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
243         WRITE(numout,*)'  level = ', jpk/2
244         CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
245         WRITE(numout,*)'  level = ', jpkm1
246         CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
[473]247      ENDIF
[2528]248      !
249   END SUBROUTINE dta_tem
[3]250
251#else
252   !!----------------------------------------------------------------------
253   !!   Default case                           NO 3D temperature data field
254   !!----------------------------------------------------------------------
[16]255   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   !: temperature data flag
[3]256CONTAINS
257   SUBROUTINE dta_tem( kt )        ! Empty routine
[16]258      WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt
[3]259   END SUBROUTINE dta_tem
260#endif
261   !!======================================================================
262END MODULE dtatem
Note: See TracBrowser for help on using the repository browser.