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.
dtachl.F90 in branches/CMIP5_IPSL/NEMO/OPA_SRC/DTA – NEMO

source: branches/CMIP5_IPSL/NEMO/OPA_SRC/DTA/dtachl.F90 @ 1829

Last change on this file since 1829 was 1829, checked in by cetlod, 14 years ago

New option to have R-B-G light penetration with 3D chlorophyll data

  • new module dtachl.F90 to read 3D monthly climatological chlorophyll data
  • update traqsr.F90 to add the new option
File size: 6.9 KB
Line 
1MODULE dtachl
2   !!======================================================================
3   !!                     ***  MODULE  dtachl  ***
4   !! Ocean data  :  read ocean chlorophyll data from monthly data
5   !!=====================================================================
6#if defined key_dtachl   ||   defined key_esopa
7   !!----------------------------------------------------------------------
8   !!   'key_dtachl'                              3D chlorophyll data field
9   !!----------------------------------------------------------------------
10   !!   dta_chl      : read ocean chlorophyll data
11   !!----------------------------------------------------------------------
12   !! * Modules used
13   USE oce             ! ocean dynamics and tracers
14   USE dom_oce         ! ocean space and time domain
15   USE in_out_manager  ! I/O manager
16   USE phycst          ! physical constants
17   USE iom   
18
19   IMPLICIT NONE
20   PRIVATE
21
22   !! * Routine accessibility
23   PUBLIC dta_chl   ! called by traqsr
24
25   !! * Shared module variables
26   LOGICAL , PUBLIC, PARAMETER ::   lk_dtachl = .TRUE.   !: chlorophyll data flag
27   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !:
28      chl_dta             !: chlorophyll data at given time-step
29
30   !! * Module variables
31   INTEGER ::   &
32      numcdt,        &  !: logical unit for data chlorophyll
33      nchl1, nchl2  ! first and second record used
34   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
35      chldta            ! chlorophyll data at two consecutive times
36
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39   !!----------------------------------------------------------------------
40   !!   OPA 9.0 , LOCEAN-IPSL (2005)
41   !! $Id: dtatem.F90 1715 2009-11-05 15:18:26Z smasson $
42   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
43   !!----------------------------------------------------------------------
44
45CONTAINS
46
47   !!----------------------------------------------------------------------
48   !!   Default case                                            NetCDF file
49   !!----------------------------------------------------------------------
50
51   SUBROUTINE dta_chl( kt )
52     !!----------------------------------------------------------------------
53     !!                   ***  ROUTINE dta_chl  ***
54     !!
55     !! ** Purpose :   Reads monthly chlorophyll data
56     !!
57     !! ** Method  : - Read on unit numcdt the monthly chlorophyll data interpo-
58     !!     lated onto the model grid.
59     !!              - At each time step, a linear interpolation is applied
60     !!     between two monthly values.
61     !!
62     !! History :
63     !!        !  91-03  ()  Original code
64     !!        !  92-07  (M. Imbard)
65     !!   9.0  !  02-06  (G. Madec)  F90: Free form and module
66     !!----------------------------------------------------------------------
67     !! * Arguments
68     INTEGER, INTENT(in) ::   kt     ! ocean time step
69
70     !! * Local declarations
71     INTEGER  ::  ji, jj, jk, jl        ! dummy loop indicies
72     INTEGER  ::  imois, iman, i15,ik   ! temporary integers
73     REAL(wp) ::   zxy,zl
74     !!----------------------------------------------------------------------
75     ! 0. Initialization
76     ! -----------------
77
78     iman  = INT( raamo ) 
79!!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) )
80     i15   = nday / 16
81     imois = nmonth + i15 - 1
82     IF( imois == 0 ) imois = iman
83
84     ! 1. First call kt=nit000
85     ! -----------------------
86
87     IF( kt == nit000 ) THEN
88
89        nchl1 = 0   ! initializations
90        IF(lwp) WRITE(numout,*) ' dta_chl : monthly chlorophyll data in NetCDF file'
91        CALL iom_open ( 'data_1m_chlorophyll_nomask', numcdt )
92
93     ENDIF
94
95     IF( kt == nit000 .OR. imois /= nchl1 ) THEN
96
97        ! 2.1 Calendar computation
98
99        nchl1 = imois        ! first file record used
100        nchl2 = nchl1 + 1    ! last  file record used
101        nchl1 = MOD( nchl1, iman )
102        IF( nchl1 == 0 ) nchl1 = iman
103        nchl2 = MOD( nchl2, iman )
104        IF( nchl2 == 0 ) nchl2 = iman
105        IF(lwp) WRITE(numout,*) 'first record file used nchl1 ', nchl1
106        IF(lwp) WRITE(numout,*) 'last  record file used nchl2 ', nchl2
107
108        ! 2.3 Read monthly chlorophyll data
109
110        CALL iom_get (numcdt,jpdom_data,'CHLA',chldta(:,:,:,1),nchl1)
111        CALL iom_get (numcdt,jpdom_data,'CHLA',chldta(:,:,:,2),nchl2)
112
113        IF(lwp) WRITE(numout,*)
114        IF(lwp) WRITE(numout,*) 'first record file used nchl1 ', nchl1
115        IF(lwp) WRITE(numout,*) 'last  record file used nchl2 ', nchl2
116        IF(lwp) WRITE(numout,*) ' read chlorophyll ok'
117        IF(lwp) WRITE(numout,*)
118       
119        ! Apply Mask
120        DO jl = 1, 2
121           chldta(:,:,:  ,jl) = chldta(:,:,:,jl) * tmask(:,:,:)
122           chldta(:,:,jpk,jl) = 0.
123           IF( ln_zps ) THEN                ! z-coord. with partial steps
124              DO jj = 1, jpj                ! interpolation of chlorophyll at the last level
125                 DO ji = 1, jpi
126                    ik = mbathy(ji,jj) - 1 
127                    IF( ik > 2 ) THEN
128                       zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
129                       chldta(ji,jj,ik,jl) = (1.-zl) * chldta(ji,jj,ik  ,jl)    &
130                          &                +     zl  * chldta(ji,jj,ik-1,jl)
131                    ENDIF
132                 END DO
133              END DO
134           ENDIF
135
136        END DO
137
138        IF( kt == nit000 .AND. lwp) THEN
139           WRITE(numout,*)' Chlorophyll month ',nchl1,nchl2
140           WRITE(numout,*)
141           WRITE(numout,*) '  month = ',nchl1,'  level = 1'
142           CALL prihre(chldta(:,:,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
143           WRITE(numout,*) '  month = ',nchl1,'  level = ',jpk/2
144           CALL prihre(chldta(:,:,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
145           WRITE(numout,*) '  month = ',nchl1,'  level = ',jpkm1
146           CALL prihre(chldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
147        ENDIF
148
149     ENDIF
150
151     ! 3. At every time step compute chlorophyll data
152     ! -------------------------------------------
153
154     zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
155     chl_dta(:,:,:) = ( ( 1.- zxy ) * chldta(:,:,:,1) + zxy * chldta(:,:,:,2) ) * tmask(:,:,:)
156
157     ! Close the file
158     ! --------------
159
160     IF( kt == nitend )   CALL iom_close (numcdt)
161
162   END SUBROUTINE dta_chl
163
164#else
165   !!----------------------------------------------------------------------
166   !!   Default case                           NO 3D chlorophyll data field
167   !!----------------------------------------------------------------------
168   USE par_oce   
169   LOGICAL , PUBLIC, PARAMETER ::   lk_dtachl = .FALSE.   !: chlorophyll data flag
170   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: chl_dta 
171CONTAINS
172   SUBROUTINE dta_chl( kt )        ! Empty routine
173      WRITE(*,*) 'dta_chl: You should not have seen this print! error?', kt
174   END SUBROUTINE dta_chl
175#endif
176   !!======================================================================
177END MODULE dtachl
Note: See TracBrowser for help on using the repository browser.