Changeset 1485
- Timestamp:
- 2009-07-06T14:58:27+02:00 (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DIA/diahth.F90
r1484 r1485 4 4 !! Ocean diagnostics: thermocline and 20 degree depth 5 5 !!====================================================================== 6 !! History : OPA ! 1994-09 (J.-P. Boulanger) Original code 7 !! ! 1996-11 (E. Guilyardi) OPA8 8 !! ! 1997-08 (G. Madec) optimization 9 !! ! 1999-07 (E. Guilyardi) hd28 + heat content 10 !! 8.5 ! 2002-06 (G. Madec) F90: Free form and module 11 !! NEMO 3.2 ! 2009-07 (S. Masson) hc300 bugfix + cleaning 12 !!---------------------------------------------------------------------- 13 6 14 #if defined key_diahth || defined key_esopa 7 15 !!---------------------------------------------------------------------- … … 34 42 # include "domzgr_substitute.h90" 35 43 !!---------------------------------------------------------------------- 36 !! OPA 9.0 , LOCEAN-IPSL (2005)44 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 37 45 !! $Id$ 38 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt46 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 39 47 !!---------------------------------------------------------------------- 40 48 … … 53 61 !! ** Method : 54 62 !! 55 !! History :56 !! ! 94-09 (J.-P. Boulanger) Original code57 !! ! 96-11 (E. Guilyardi) OPA858 !! ! 97-08 (G. Madec) optimization59 !! ! 99-07 (E. Guilyardi) hd28 + heat content60 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module61 63 !!------------------------------------------------------------------- 62 !! * Arguments63 64 INTEGER, INTENT( in ) :: kt ! ocean time-step index 64 65 !! * Local declarations 66 INTEGER :: ji, jj, jk ! dummy loop arguments 67 INTEGER :: iid, iif, ilevel ! temporary integers 68 INTEGER, DIMENSION(jpi) :: idepth 69 INTEGER, DIMENSION(jpi,jpj) :: ikc 70 71 REAL(wp) :: zd, zmoy, zthick_0, zcoef ! temporary scalars 72 REAL(wp), DIMENSION(jpi) :: zmax 73 REAL(wp), DIMENSION(jpi,jpj) :: zthick 74 REAL(wp), DIMENSION(jpi,jpk) :: zdzt 65 !! 66 INTEGER :: ji, jj, jk ! dummy loop arguments 67 INTEGER :: iid, iif, ilevel ! temporary integers 68 INTEGER, DIMENSION(jpi,jpj) :: ikc ! levels 69 REAL(wp) :: zd, zthick_0, zcoef ! temporary scalars 70 REAL(wp), DIMENSION(jpi,jpj) :: zthick 71 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdzt 75 72 !!---------------------------------------------------------------------- 76 73 … … 82 79 ENDIF 83 80 84 85 81 ! -------------------------- ! 86 82 ! Depth of the thermocline ! … … 88 84 ! The depth of the thermocline is defined as the depth of the 89 85 ! strongest vertical temperature gradient 90 86 zdzt(:,:,1) = 0.e0 87 DO jk = 2, jpk ! vertical gradient of temperature 88 zdzt(:,:,jk) = ( tn(:,:,jk-1) - tn(:,:,jk) ) / fse3w(:,:,jk) * tmask(:,:,jk) 89 END DO 91 90 DO jj = 1, jpj 92 93 ! vertical gradient of temperature 94 DO jk = 2, jpkm1 95 zdzt(:,jk) = ( tn(:,jj,jk-1) - tn(:,jj,jk) ) / fse3w(:,jj,jk) * tmask(:,jj,jk) 96 END DO 97 98 ! search the level of maximum vertical temperature gradient 99 zmax (:) = 0.e0 100 idepth(:) = 1 101 DO jk = jpkm1, 2, -1 102 DO ji = 1, jpi 103 IF( zdzt(ji,jk) > zmax(ji) ) THEN 104 zmax (ji) = zdzt(ji,jk) 105 idepth(ji) = jk 106 ENDIF 107 END DO 108 END DO 91 DO ji = 1, jpi 92 ilevel = MAXLOC( zdzt(ji,jj,:), dim= 1 ) ! level of maximum vertical temperature gradient 93 hth(ji,jj) = fsdepw(ji,jj,ilevel) ! depth of the thermocline 94 END DO 95 END DO 109 96 110 ! depth of the thermocline 111 DO ji = 1, jpi 112 hth(ji,jj) = fsdepw(ji,jj,idepth(ji)) 113 END DO 114 115 END DO 116 CALL iom_put( "thermod", hth ) ! depth of the thermocline 117 97 CALL iom_put( "thermod", hth ) ! depth of the thermocline 118 98 119 99 ! ----------------------- ! 120 100 ! Depth of 20C isotherm ! 121 101 ! ----------------------- ! 122 123 ! initialization to the number of ocean w-point mbathy 124 ! (cf dommsk, minimum value: 1) 125 ikc(:,:) = 1 126 127 ! search the depth of 20 degrees isotherm 128 ! ( starting from the top, last level above 20C, if not exist, = 1) 129 DO jk = 1, jpkm1 130 DO jj = 1, jpj 131 DO ji = 1, jpi 132 IF( tn(ji,jj,jk) >= 20. ) ikc(ji,jj) = jk 133 END DO 102 103 ! search last level above 20C 104 ikc(:,:) = COUNT( tn >= 20., dim = 3 ) 105 ! Depth of 20C isotherm, linear interpolation 106 DO jj = 1, jpj 107 DO ji = 1, jpi 108 iid = MAX(1, ikc(ji,jj)) 109 zd = fsdept(ji,jj,iid) + ( fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) ) & 110 & * ( 20.*tmask(ji,jj,iid+1) - tn(ji,jj,iid) ) & 111 & / ( tn(ji,jj,iid+1) - tn(ji,jj,iid) + ( 1. - tmask(ji,jj,1) ) ) 112 ! bound by the ocean depth, minimum value, first T-point depth 113 iif = mbathy(ji,jj) 114 hd20(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif) ) 134 115 END DO 135 116 END DO 136 137 ! Depth of 20C isotherm 138 DO jj = 1, jpj 139 DO ji = 1, jpi 140 iid = ikc(ji,jj) 141 iif = mbathy(ji,jj) 142 IF( iid /= 1 ) THEN 143 ! linear interpolation 144 zd = fsdept(ji,jj,iid) & 145 + ( fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) ) & 146 * ( 20.*tmask(ji,jj,iid+1) - tn(ji,jj,iid) ) & 147 / ( tn(ji,jj,iid+1) - tn(ji,jj,iid) & 148 + (1.-tmask(ji,jj,1)) ) 149 ! bound by the ocean depth, minimum value, first T-point depth 150 hd20(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif)) 151 ELSE 152 hd20(ji,jj)=0. 153 ENDIF 154 END DO 155 END DO 156 CALL iom_put( "20d", hd20 ) ! depth of the 20 isotherm 117 WHERE(ikc == 0 ) hd20 = 0.e0 118 CALL iom_put( "20d", hd20 ) ! depth of the 20 isotherm 157 119 158 120 ! ----------------------- ! … … 160 122 ! ----------------------- ! 161 123 162 ! initialization to the number of ocean w-point mbathy 163 ! (cf dommsk, minimum value: 1) 164 ikc(:,:) = 1 165 166 ! search the depth of 28 degrees isotherm 167 ! ( starting from the top, last level above 28C, if not exist, = 1) 168 DO jk = 1, jpkm1 169 DO jj = 1, jpj 170 DO ji = 1, jpi 171 IF( tn(ji,jj,jk) >= 28. ) ikc(ji,jj) = jk 172 END DO 124 ! search last level above 28C 125 ikc(:,:) = COUNT( tn >= 28., dim = 3 ) 126 ! Depth of 28C isotherm, linear interpolation 127 DO jj = 1, jpj 128 DO ji = 1, jpi 129 iid = MAX(1, ikc(ji,jj)) 130 zd = fsdept(ji,jj,iid) + ( fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) ) & 131 & * ( 28.*tmask(ji,jj,iid+1) - tn(ji,jj,iid) ) & 132 & / ( tn(ji,jj,iid+1) - tn(ji,jj,iid) + ( 1. - tmask(ji,jj,1) ) ) 133 ! bound by the ocean depth, minimum value, first T-point depth 134 iif = mbathy(ji,jj) 135 hd28(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif) ) 173 136 END DO 174 137 END DO 175 176 ! Depth of 28C isotherm 177 DO jj = 1, jpj 178 DO ji = 1, jpi 179 iid = ikc(ji,jj) 180 iif = mbathy(ji,jj) 181 IF( iid /= 1 ) THEN 182 ! linear interpolation 183 zd = fsdept(ji,jj,iid) & 184 + ( fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) ) & 185 * ( 28.*tmask(ji,jj,iid+1) - tn(ji,jj,iid) ) & 186 / ( tn(ji,jj,iid+1) - tn(ji,jj,iid) & 187 + ( 1. - tmask(ji,jj,1) ) ) 188 ! bound by the ocean depth, minimum value, first T-point depth 189 hd28(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif) ) 190 ELSE 191 hd28(ji,jj) = 0. 192 ENDIF 193 END DO 194 END DO 195 CALL iom_put( "28d", hd28 ) ! depth of the 28 isotherm 138 WHERE(ikc == 0 ) hd28 = 0.e0 139 CALL iom_put( "28d", hd28 ) ! depth of the 28 isotherm 196 140 197 ! ----------------------------- ------------!198 ! Heat content of first 300 m (18 levels)!199 ! ----------------------------- ------------!141 ! ----------------------------- ! 142 ! Heat content of first 300 m ! 143 ! ----------------------------- ! 200 144 201 145 ! find ilevel with (ilevel+1) the deepest W-level above 300m (we assume we can use e3t_0 to do this search...) … … 221 165 zcoef = rau0 * rcp 222 166 htc3(:,:) = zcoef * htc3(:,:) 223 CALL iom_put( "hc300", htc3 ) ! first 300m heaat content 167 CALL iom_put( "hc300", htc3 ) ! first 300m heaat content 168 224 169 225 170 END SUBROUTINE dia_hth
Note: See TracChangeset
for help on using the changeset viewer.