source: lim1d_ws/trunk/SOURCES/source_3.20/ice_bio_interp_bio2phy.f @ 2

Last change on this file since 2 was 2, checked in by vancop, 8 years ago

initial import /Users/ioulianikolskaia/Boulot/CODES/LIM1D/ARCHIVE/TMP/LIM1D_v3.20/
File size: 4.7 KB
Line 
1      SUBROUTINE ice_bio_interp_bio2phy(kideb,kiut,nlay_i,ln_write)
2
3! This routine interpolates chlorophyll a
4! from the biological grid to the physical grid
5! (c) Martin Vancoppenolle, May 2007
6 
7      INCLUDE 'type.com'
8      INCLUDE 'para.com'
9      INCLUDE 'const.com'
10      INCLUDE 'ice.com'
11      INCLUDE 'thermo.com'
12      INCLUDE 'bio.com'
13
14      INTEGER :: 
15     &  ji          , ! : index for space
16     &  jk          , ! : index for ice layers
17     &  jn          , ! : index for tracers
18     &  layer1      , ! : relayering index
19     &  layer2        ! : relayering index
20
21      REAL(8), DIMENSION( 0:nlay_bio ) ::
22     &  z0
23
24      REAL(8), DIMENSION( 0:maxnlay ) ::
25     &  z1
26
27      REAL(8), DIMENSION( nlay_bio ) ::
28     &  zqc         , ! : scalar content on the physical grid (input)
29     &  zthick0       ! : thickness of biological layers
30
31      REAL(8), DIMENSION( maxnlay ) ::
32     &  zq1         , ! : scalar content on the biological grid (output)
33     &  zthick1       ! : thickness of physical layers
34
35      REAL(8), DIMENSION( maxnlay , nlay_bio ) ::
36     &  zweight       ! : relayering matrix
37
38      LOGICAL ::
39     &  ln_write
40
41!=============================================================================!
42
43      IF ( ln_write ) THEN
44         WRITE(numout,*) ' *** ice_bio_interp_bio2phy : '
45         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
46      ENDIF
47!
48!-----------------------------------------------------------------------------!
49! 1) Grids
50!-----------------------------------------------------------------------------!
51!
52! compute the coordinates of the interfaces of the layers
53     
54      DO ji = kideb, kiut
55      !---------------
56      ! Physical grid
57      !---------------
58      z1(0) = 0.0
59      DO layer = 1, nlay_i
60         z1(layer) = ht_i_b(ji) / nlay_i * layer
61         zthick1(layer) = z1(layer) - z1(layer-1)
62      END DO ! layer
63
64!     !+++++
65!     WRITE(numout,*) ' z1      : ', ( z1(layer1) ,
66!    &                layer1 = 0, nlay_i )
67!     WRITE(numout,*) ' zthick1 : ', ( zthick1(layer1) ,
68!    &                layer1 = 1, nlay_i )
69!     !+++++
70
71      !-----------------
72      ! Biological grid
73      !-----------------
74      z0(0) = 0.0
75      DO layer = 1, nlay_bio
76         z0(layer) = z0(layer-1) + deltaz_i_bio(layer)
77         zthick0(layer) = z0(layer) - z0(layer-1)
78      END DO ! layer
79
80!     !+++++
81!     WRITE(numout,*) ' z0      : ', ( z0(layer1) ,
82!    &                layer1 = 1, nlay_bio )
83!     WRITE(numout,*) ' zthick0 : ', ( zthick0(layer1) ,
84!    &                layer1 = 1, nlay_bio )
85!     !+++++
86!
87!-----------------------------------------------------------------------------!
88! 2) Scalar contents
89!-----------------------------------------------------------------------------!
90!
91      DO layer = 1, nlay_bio
92         zqc(layer) = chla_i_bio(layer) * zthick0(layer)
93      END DO ! layer
94
95!     !+++++
96!     WRITE(numout,*) ' chla_i_bio :', ( chla_i_bio(layer) ,
97!    &                layer = 1, nlay_bio )
98!     WRITE(numout,*) ' zqc     : ', ( zqc(layer) ,
99!    &                layer = 1, nlay_bio )
100!     !+++++
101!
102!-----------------------------------------------------------------------------!
103! 3) Weights
104!-----------------------------------------------------------------------------!
105!
106      ! weights of old layers on new ones
107      DO layer1 = 1, nlay_i
108         DO layer0 = 1, nlay_bio
109            zweight(layer1,layer0) = MAX ( 0.0 , ( MIN ( z0(layer0) ,
110     &      z1(layer1) ) - MAX ( z0 (layer0-1) , z1(layer1-1) ) ) / 
111     &      zthick0(layer0) )
112!           WRITE(numout,*) ' zweight : ', layer1, layer0,
113!    &                      zweight(layer1, layer0)
114         END DO
115      END DO
116!
117!-----------------------------------------------------------------------------!
118! 4) Interpolation
119!-----------------------------------------------------------------------------!
120!
121      !---------------
122      ! Chlorophyll a
123      !---------------
124      DO layer1 = 1, nlay_i
125         zq1(layer1) = 0.0
126         DO layer0 = 1, nlay_bio
127            zq1(layer1) = zq1(layer1) + zweight(layer1,layer0) *
128     &                    zqc(layer0)
129         END DO
130      END DO
131!     !+++++
132!     WRITE(numout,*) ' Chlorophyll a : '
133!     WRITE(numout,*) ' zq1     : ', ( zq1(layer1) ,
134!    &                layer1 = 1, nlay_i )
135!     !+++++
136
137      DO layer1 = 1, nlay_i
138         chla_i(layer1) = zq1(layer1) / zthick1(layer1)
139      END DO
140
141      END DO ! ji
142
143!     WRITE(numout,*) ' chla_i  : ', ( chla_i(layer1) ,
144!    &                layer1 = 1, nlay_i )
145
146!     WRITE(numout,*) ' end '
147!     WRITE(numout,*) ' ------------------------------------ '
148!=============================================================================!
149!-- End of ice_bio_interp_bio2phy --
150 
151      END
Note: See TracBrowser for help on using the repository browser.