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.
trcdta.F90 in trunk/NEMOGCM/NEMO/TOP_SRC – NEMO

source: trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90 @ 2715

Last change on this file since 2715 was 2715, checked in by rblod, 13 years ago

First attempt to put dynamic allocation on the trunk
  • Property svn:keywords set to Id
File size: 9.6 KB
Line 
1MODULE trcdta
2   !!======================================================================
3   !!                     ***  MODULE  trcdta  ***
4   !! TOP :  reads passive tracer data
5   !!=====================================================================
6   !! History :   1.0  !  2002-04  (O. Aumont)  original code
7   !!              -   !  2004-03  (C. Ethe)  module
8   !!              -   !  2005-03  (O. Aumont, A. El Moussaoui) F90
9   !!----------------------------------------------------------------------
10#if  defined key_top  &&  defined key_dtatrc
11   !!----------------------------------------------------------------------
12   !!   'key_top'  and  'key_dtatrc'        TOP model + passive tracer data
13   !!----------------------------------------------------------------------
14   !!   trc_dta      : read ocean passive tracer data
15   !!----------------------------------------------------------------------
16   USE oce_trc
17   USE par_trc
18   USE trc
19   USE lib_print
20   USE iom
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90
26   PUBLIC   trc_dta_alloc   ! called in nemogcm.F90
27
28   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .TRUE.   !: temperature data flag
29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trdta   !: tracer data at given time-step
30
31   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   tracdta       ! tracer data at two consecutive times
32   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nlectr      !: switch for reading once
33   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc1       !: number of 1st month when reading 12 monthly value
34   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc2       !: number of 2nd month when reading 12 monthly value
35
36   !! * Substitutions
37#  include "top_substitute.h90"
38   !!----------------------------------------------------------------------
39   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
40   !! $Id$
41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
42   !!----------------------------------------------------------------------
43CONTAINS
44
45   SUBROUTINE trc_dta( kt )
46      !!----------------------------------------------------------------------
47      !!                   ***  ROUTINE trc_dta  ***
48      !!
49      !! ** Purpose :   Reads passive tracer data (Levitus monthly data)
50      !!
51      !! ** Method  :   Read on unit numtr the interpolated tracer concentra-
52      !!      tion onto the global grid. Data begin at january.
53      !!      The value is centered at the middle of month.
54      !!      In the opa model, kt=1 agree with january 1.
55      !!      At each time step, a linear interpolation is applied between
56      !!      two monthly values.
57      !!----------------------------------------------------------------------
58      INTEGER, INTENT(in) ::   kt     ! ocean time-step
59      !!
60      CHARACTER (len=39) ::   clname(jptra)
61      INTEGER, PARAMETER ::   jpmonth = 12    ! number of months
62      INTEGER ::   ji, jj, jn, jl 
63      INTEGER ::   imois, iman, i15, ik  ! temporary integers
64      REAL(wp) ::   zxy, zl
65!!gm HERE the daymod should be used instead of computation of month and co !!
66!!gm      better in case of real calandar and leap-years !
67      !!----------------------------------------------------------------------
68
69      DO jn = 1, jptra
70
71         IF( lutini(jn) ) THEN
72
73            IF ( kt == nit000 ) THEN
74               !! 3D tracer data
75               IF(lwp)WRITE(numout,*)
76               IF(lwp)WRITE(numout,*) ' dta_trc: reading tracer' 
77               IF(lwp)WRITE(numout,*) ' data file ', jn, ctrcnm(jn)
78               IF(lwp)WRITE(numout,*)
79               nlectr(jn) = 0
80            ENDIF
81            ! Initialization
82            iman = jpmonth
83            i15  = nday / 16
84            imois = nmonth + i15 -1
85            IF( imois == 0 ) imois = iman
86
87
88            ! First call kt=nit000
89            ! --------------------
90
91            IF ( kt == nit000 .AND. nlectr(jn) == 0 ) THEN
92               ntrc1(jn) = 0
93               IF(lwp) WRITE(numout,*) ' trc_dta : Levitus tracer data monthly fields'
94               ! open file
95# if defined key_pisces
96               clname(jn) = 'data_1m_'//TRIM(ctrcnm(jn))//'_nomask'
97# else
98               clname(jn) = TRIM(ctrcnm(jn))
99# endif
100               CALL iom_open ( clname(jn), numtr(jn) )             
101
102            ENDIF
103
104# if defined key_pisces
105            ! Read montly file
106            IF( ( kt == nit000 .AND. nlectr(jn) == 0)  .OR. imois /= ntrc1(jn) ) THEN
107               nlectr(jn) = 1
108
109               ! Calendar computation
110
111               ! ntrc1 number of the first file record used in the simulation
112               ! ntrc2 number of the last  file record
113
114               ntrc1(jn) = imois
115               ntrc2(jn) = ntrc1(jn) + 1
116               ntrc1(jn) = MOD( ntrc1(jn), iman )
117               IF ( ntrc1(jn) == 0 ) ntrc1(jn) = iman
118               ntrc2(jn) = MOD( ntrc2(jn), iman )
119               IF ( ntrc2(jn) == 0 ) ntrc2(jn) = iman
120               IF(lwp) WRITE(numout,*) 'first record file used ntrc1 ', ntrc1(jn) 
121               IF(lwp) WRITE(numout,*) 'last  record file used ntrc2 ', ntrc2(jn)
122
123               ! Read montly passive tracer data Levitus
124
125               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), tracdta(:,:,:,jn,1), ntrc1(jn) )
126               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), tracdta(:,:,:,jn,2), ntrc2(jn) )
127
128               IF(lwp) THEN
129                  WRITE(numout,*)
130                  WRITE(numout,*) ' read tracer data ', ctrcnm(jn),' ok'
131                  WRITE(numout,*)
132               ENDIF
133
134               ! Apply Mask
135               DO jl = 1, 2
136                  tracdta(:,:,:  ,jn,jl) = tracdta(:,:,:,jn,jl) * tmask(:,:,:) 
137                  tracdta(:,:,jpk,jn,jl) = 0.
138                  IF( ln_zps ) THEN                ! z-coord. with partial steps
139                     DO jj = 1, jpj                ! interpolation of temperature at the last level
140                        DO ji = 1, jpi
141                           ik = mbkt(ji,jj)
142                           IF( ik > 2 ) THEN
143                              zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
144                              tracdta(ji,jj,ik,jn,jl) = (1.-zl) * tracdta(ji,jj,ik  ,jn,jl)    &
145                                 &                    +     zl  * tracdta(ji,jj,ik-1,jn,jl)
146                           ENDIF
147                        END DO
148                     END DO
149                  ENDIF
150
151               END DO
152
153            ENDIF
154
155            IF(lwp) THEN
156               WRITE(numout,*) ctrcnm(jn), 'Levitus month ', ntrc1(jn), ntrc2(jn)
157               WRITE(numout,*)
158               WRITE(numout,*) ' Levitus month = ', ntrc1(jn), '  level = 1'
159               CALL prihre( tracdta(1,1,1,jn,1), jpi, jpj, 1, jpi, 20, 1   &
160                  &        ,jpj, 20, 1., numout )
161               WRITE(numout,*) ' Levitus month = ', ntrc1(jn), '  level = ',jpk/2
162               CALL prihre( tracdta(1,1,jpk/2,jn,1), jpi, jpj, 1, jpi,    &
163                  &         20, 1, jpj, 20, 1., numout )
164               WRITE(numout,*) ' Levitus month = ',ntrc1(jn),'  level = ',jpkm1
165               CALL prihre( tracdta(1,1,jpkm1,jn,1), jpi, jpj, 1, jpi,     &
166                  &         20, 1, jpj, 20, 1., numout )
167            ENDIF
168
169            ! At every time step compute temperature data
170            zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
171            trdta(:,:,:,jn) =  ( 1. - zxy ) * tracdta(:,:,:,jn,1)    &
172               &              +       zxy   * tracdta(:,:,:,jn,2) 
173
174            IF( jn == jpno3 )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   7.6e-6
175            IF( jn == jpdic )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6
176            IF( jn == jptal )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6
177            IF( jn == jpoxy )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *  44.6e-6
178            IF( jn == jpsil )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6
179            IF( jn == jppo4 )   trdta(:,:,:,jn) = trdta(:,:,:,jn) * 122.0e-6
180
181            ! Close the file
182            ! --------------
183           
184            IF( kt == nitend )   CALL iom_close( numtr(jn) )
185
186# else
187            ! Read init file only
188            IF( kt == nit000  ) THEN
189               ntrc1(jn) = 1
190               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) )
191               trdta(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:)
192               CALL iom_close ( numtr(jn) )
193            ENDIF 
194# endif
195         ENDIF
196
197      END DO
198      !
199   END SUBROUTINE trc_dta
200
201
202   INTEGER FUNCTION trc_dta_alloc()
203      !!----------------------------------------------------------------------
204      !!                   ***  ROUTINE trc_dta_alloc  ***
205      !!----------------------------------------------------------------------
206      ALLOCATE( trdta  (jpi,jpj,jpk,jptra  ) ,                    &
207         &      tracdta(jpi,jpj,jpk,jptra,2) ,                    &
208         &      nlectr(jptra) , ntrc1(jptra) , ntrc2(jptra) , STAT=trc_dta_alloc)
209         !
210      IF( trc_dta_alloc /= 0 )   CALL ctl_warn('trc_dta_alloc : failed to allocate arrays')
211      !
212   END FUNCTION trc_dta_alloc
213
214#else
215   !!----------------------------------------------------------------------
216   !!   Dummy module                              NO 3D passive tracer data
217   !!----------------------------------------------------------------------
218   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .FALSE.   !: temperature data flag
219CONTAINS
220   SUBROUTINE trc_dta( kt )        ! Empty routine
221      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt
222   END SUBROUTINE trc_dta
223#endif
224
225   !!======================================================================
226END MODULE trcdta
Note: See TracBrowser for help on using the repository browser.