MODULE dtachl !!====================================================================== !! *** MODULE dtachl *** !! Ocean data : read ocean chlorophyll data from monthly data !!===================================================================== #if defined key_dtachl || defined key_esopa !!---------------------------------------------------------------------- !! 'key_dtachl' 3D chlorophyll data field !!---------------------------------------------------------------------- !! dta_chl : read ocean chlorophyll data !!---------------------------------------------------------------------- !! * 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 USE iom IMPLICIT NONE PRIVATE !! * Routine accessibility PUBLIC dta_chl ! called by traqsr !! * Shared module variables LOGICAL , PUBLIC, PARAMETER :: lk_dtachl = .TRUE. !: chlorophyll data flag REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: chl_dta !: chlorophyll data at given time-step !! * Module variables INTEGER :: & numcdt, & !: logical unit for data chlorophyll nchl1, nchl2 ! first and second record used REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & chldta ! chlorophyll 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_chl( kt ) !!---------------------------------------------------------------------- !! *** ROUTINE dta_chl *** !! !! ** Purpose : Reads monthly chlorophyll data !! !! ** Method : - Read on unit numcdt the monthly chlorophyll data interpo- !! lated onto the model grid. !! - At each time step, a linear interpolation is applied !! between two monthly values. !! !! History : !! ! 91-03 () Original code !! ! 92-07 (M. Imbard) !! 9.0 ! 02-06 (G. Madec) F90: Free form and module !!---------------------------------------------------------------------- !! * Arguments INTEGER, INTENT(in) :: kt ! ocean time step !! * Local declarations INTEGER :: ji, jj, jk, jl ! dummy loop indicies INTEGER :: imois, iman, i15,ik ! temporary integers REAL(wp) :: zxy,zl !!---------------------------------------------------------------------- ! 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 nchl1 = 0 ! initializations IF(lwp) WRITE(numout,*) ' dta_chl : monthly chlorophyll data in NetCDF file' CALL iom_open ( 'data_1m_chlorophyll_nomask', numcdt ) ENDIF IF( kt == nit000 .OR. imois /= nchl1 ) THEN ! 2.1 Calendar computation nchl1 = imois ! first file record used nchl2 = nchl1 + 1 ! last file record used nchl1 = MOD( nchl1, iman ) IF( nchl1 == 0 ) nchl1 = iman nchl2 = MOD( nchl2, iman ) IF( nchl2 == 0 ) nchl2 = iman IF(lwp) WRITE(numout,*) 'first record file used nchl1 ', nchl1 IF(lwp) WRITE(numout,*) 'last record file used nchl2 ', nchl2 ! 2.3 Read monthly chlorophyll data CALL iom_get (numcdt,jpdom_data,'CHLA',chldta(:,:,:,1),nchl1) CALL iom_get (numcdt,jpdom_data,'CHLA',chldta(:,:,:,2),nchl2) IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'first record file used nchl1 ', nchl1 IF(lwp) WRITE(numout,*) 'last record file used nchl2 ', nchl2 IF(lwp) WRITE(numout,*) ' read chlorophyll ok' IF(lwp) WRITE(numout,*) ! Apply Mask DO jl = 1, 2 chldta(:,:,: ,jl) = chldta(:,:,:,jl) * tmask(:,:,:) chldta(:,:,jpk,jl) = 0. IF( ln_zps ) THEN ! z-coord. with partial steps DO jj = 1, jpj ! interpolation of chlorophyll 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) ) chldta(ji,jj,ik,jl) = (1.-zl) * chldta(ji,jj,ik ,jl) & & + zl * chldta(ji,jj,ik-1,jl) ENDIF END DO END DO ENDIF END DO IF( kt == nit000 .AND. lwp) THEN WRITE(numout,*)' Chlorophyll month ',nchl1,nchl2 WRITE(numout,*) WRITE(numout,*) ' month = ',nchl1,' level = 1' CALL prihre(chldta(:,:,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) WRITE(numout,*) ' month = ',nchl1,' level = ',jpk/2 CALL prihre(chldta(:,:,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) WRITE(numout,*) ' month = ',nchl1,' level = ',jpkm1 CALL prihre(chldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) ENDIF ENDIF ! 3. At every time step compute chlorophyll data ! ------------------------------------------- zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. chl_dta(:,:,:) = ( ( 1.- zxy ) * chldta(:,:,:,1) + zxy * chldta(:,:,:,2) ) * tmask(:,:,:) ! Close the file ! -------------- IF( kt == nitend ) CALL iom_close (numcdt) END SUBROUTINE dta_chl #else !!---------------------------------------------------------------------- !! Default case NO 3D chlorophyll data field !!---------------------------------------------------------------------- USE par_oce LOGICAL , PUBLIC, PARAMETER :: lk_dtachl = .FALSE. !: chlorophyll data flag REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: chl_dta CONTAINS SUBROUTINE dta_chl( kt ) ! Empty routine WRITE(*,*) 'dta_chl: You should not have seen this print! error?', kt END SUBROUTINE dta_chl #endif !!====================================================================== END MODULE dtachl