MODULE dtatem !!====================================================================== !! *** MODULE dtatem *** !! Ocean data : read ocean temperature data from monthly atlas data !!===================================================================== #if defined key_dtatem || defined key_esopa !!---------------------------------------------------------------------- !! 'key_dtatem' 3D temperature data field !!---------------------------------------------------------------------- !! dta_tem : read ocean temperature data !!---l------------------------------------------------------------------- !! * Modules used USE oce ! ocean dynamics and tracers USE dom_oce ! ocean space and time domain USE in_out_manager ! I/O manager USE phycst ! physical constants #if defined key_orca_lev10 USE lbclnk ! ocean lateral boundary conditions (or mpp link) #endif IMPLICIT NONE PRIVATE !! * Routine accessibility PUBLIC dta_tem ! called by step.F90 and inidta.F90 !! * Shared module variables LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .TRUE. !: temperature data flag REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: t_dta !: temperature data at given time-step !! * Module variables INTEGER :: & numtdt, & !: logical unit for data temperature ntem1, ntem2 ! first and second record used REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & temdta ! temperature data at two consecutive times !! * Substitutions # include "domzgr_substitute.h90" !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2005) !! $Id: dtatem.F90 1715 2009-11-05 15:18:26Z smasson $ !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt !!---------------------------------------------------------------------- CONTAINS !!---------------------------------------------------------------------- !! Default case NetCDF file !!---------------------------------------------------------------------- SUBROUTINE dta_tem( kt ) !!---------------------------------------------------------------------- !! *** ROUTINE dta_tem *** !! !! ** Purpose : Reads monthly temperature data !! !! ** Method : Read on unit numtdt the interpolated temperature !! onto the model grid. !! Data begin at january. !! The value is centered at the middle of month. !! In the opa model, kt=1 agree with january 1. !! At each time step, a linear interpolation is applied between !! two monthly values. !! Read on unit numtdt !! !! ** Action : define t_dta array at time-step kt !! !! History : !! ! 91-03 () Original code !! ! 92-07 (M. Imbard) !! ! 99-10 (M.A. Foujols, M. Imbard) NetCDF FORMAT !! 8.5 ! 02-09 (G. Madec) F90: Free form and module !!---------------------------------------------------------------------- !! * Modules used USE iom !! * Arguments INTEGER, INTENT( in ) :: kt ! ocean time-step !! * Local declarations INTEGER :: ji, jj, jl, jk, jkk ! dummy loop indicies INTEGER :: & imois, iman, i15 , ik ! temporary integers # if defined key_tradmp INTEGER :: & il0, il1, ii0, ii1, ij0, ij1 ! temporary integers # endif REAL(wp) :: zxy, zl #if defined key_orca_lev10 REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem INTEGER :: ikr, ikw, ikt, jjk REAL(wp) :: zfac #endif REAL(wp), DIMENSION(jpk,2) :: & ztemdta ! auxiliary array for interpolation !!---------------------------------------------------------------------- ! 0. Initialization ! ----------------- iman = INT( raamo ) !!! better but change the results i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) i15 = nday / 16 imois = nmonth + i15 - 1 IF( imois == 0 ) imois = iman ! 1. First call kt=nit000 ! ----------------------- IF( kt == nit000 ) THEN ntem1= 0 ! initializations IF(lwp) WRITE(numout,*) ' dta_tem : Levitus monthly fields' CALL iom_open ( 'data_1m_potential_temperature_nomask', numtdt ) ENDIF ! 2. Read monthly file ! ------------------- IF( kt == nit000 .OR. imois /= ntem1 ) THEN ! Calendar computation ntem1 = imois ! first file record used ntem2 = ntem1 + 1 ! last file record used ntem1 = MOD( ntem1, iman ) IF( ntem1 == 0 ) ntem1 = iman ntem2 = MOD( ntem2, iman ) IF( ntem2 == 0 ) ntem2 = iman IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 IF(lwp) WRITE(numout,*) 'last record file used ntem2 ', ntem2 ! Read monthly temperature data Levitus #if defined key_orca_lev10 if (ln_zps) stop ztem(:,:,:,:) = 0. CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,1),ntem1) CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,2),ntem2) #else CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,1),ntem1) CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,2),ntem2) #endif IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' IF(lwp) WRITE(numout,*) #if defined key_tradmp IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ! ======================= ! ! ORCA_R2 configuration ! ! ======================= ij0 = 101 ; ij1 = 109 ii0 = 141 ; ii1 = 155 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea DO ji = mi0(ii0), mi1(ii1) #if defined key_orca_lev10 ztem( ji,jj, 13:13 ,:) = ztem (ji,jj, 13:13 ,:) - 0.20 ztem (ji,jj, 14:15 ,:) = ztem (ji,jj, 14:15 ,:) - 0.35 ztem (ji,jj, 16:25 ,:) = ztem (ji,jj, 16:25 ,:) - 0.40 #else temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 #endif END DO END DO IF( n_cla == 1 ) THEN ! ! New temperature profile at Gibraltar il0 = 138 ; il1 = 138 ij0 = 101 ; ij1 = 102 ii0 = 139 ; ii1 = 139 DO jl = mi0(il0), mi1(il1) DO jj = mj0(ij0), mj1(ij1) DO ji = mi0(ii0), mi1(ii1) #if defined key_orca_lev10 ztem (ji,jj,:,:) = ztem (jl,jj,:,:) #else temdta(ji,jj,:,:) = temdta(jl,jj,:,:) #endif END DO END DO END DO ! ! New temperature profile at Bab el Mandeb il0 = 164 ; il1 = 164 ij0 = 87 ; ij1 = 88 ii0 = 161 ; ii1 = 163 DO jl = mi0(il0), mi1(il1) DO jj = mj0(ij0), mj1(ij1) DO ji = mi0(ii0), mi1(ii1) #if defined key_orca_lev10 ztem (ji,jj,:,:) = ztem (jl,jj,:,:) #else temdta(ji,jj,:,:) = temdta(jl,jj,:,:) #endif END DO END DO END DO ! ELSE ! ! Reduced temperature at Red Sea ij0 = 87 ; ij1 = 96 ii0 = 148 ; ii1 = 160 #if defined key_orca_lev10 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 #else temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 #endif ENDIF ! ENDIF #endif #if defined key_orca_lev10 ! interpolate from 31 to 301 level the ztem field result in temdta DO jl = 1, 2 DO jjk = 1, 5 temdta(:,:,jjk,jl) = ztem(:,:,1,jl) END DO DO jk = 1, jpk-20,10 ik = jk+5 ikr = INT(jk/10) + 1 ikw = (ikr-1) *10 + 1 ikt = ikw + 5 DO jjk=ikt,ikt+9 zfac = ( gdept_0(jjk ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) temdta(:,:,jjk,jl) = ztem(:,:,ikr,jl) + ( ztem(:,:,ikr+1,jl) - ztem(:,:,ikr,jl) ) * zfac END DO END DO DO jjk = jpk-5, jpk temdta(:,:,jjk,jl) = ztem(:,:,jpkdta-1,jl) END DO ! fill the overlap areas CALL lbc_lnk (temdta(:,:,:,jl),'Z',-999.,'no0') END DO #endif IF( ln_sco ) THEN DO jl = 1, 2 DO jj = 1, jpj ! interpolation of temperatures DO ji = 1, jpi DO jk = 1, jpk zl=fsdept_0(ji,jj,jk) IF(zl < gdept_0(1)) ztemdta(jk,jl) = temdta(ji,jj,1,jl) IF(zl > gdept_0(jpk)) ztemdta(jk,jl) = temdta(ji,jj,jpkm1,jl) DO jkk = 1, jpkm1 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN ztemdta(jk,jl) = temdta(ji,jj,jkk,jl) & & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & & *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl)) ENDIF END DO END DO DO jk = 1, jpkm1 temdta(ji,jj,jk,jl) = ztemdta(jk,jl) END DO temdta(ji,jj,jpk,jl) = 0.0 END DO END DO END DO IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' IF(lwp) WRITE(numout,*) ELSE ! ! Mask DO jl = 1, 2 temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) temdta(:,:,jpk,jl) = 0. IF( ln_zps ) THEN ! z-coord. with partial steps DO jj = 1, jpj ! interpolation of temperature at the last level DO ji = 1, jpi ik = mbathy(ji,jj) - 1 IF( ik > 2 ) THEN zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) ENDIF END DO END DO ENDIF END DO ENDIF IF(lwp) THEN WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 WRITE(numout,*) WRITE(numout,*) ' Levitus month = ', ntem1, ' level = 1' CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) WRITE(numout,*) ' Levitus month = ', ntem1, ' level = ', jpk/2 CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) WRITE(numout,*) ' Levitus month = ',ntem1,' level = ', jpkm1 CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) ENDIF ENDIF ! 2. At every time step compute temperature data ! ---------------------------------------------- zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) ! Close the file ! -------------- IF( kt == nitend ) CALL iom_close (numtdt) END SUBROUTINE dta_tem #else !!---------------------------------------------------------------------- !! Default case NO 3D temperature data field !!---------------------------------------------------------------------- LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .FALSE. !: temperature data flag CONTAINS SUBROUTINE dta_tem( kt ) ! Empty routine WRITE(*,*) 'dta_tem: You should not have seen this print! error?', kt END SUBROUTINE dta_tem #endif !!====================================================================== END MODULE dtatem