- Timestamp:
- 2018-11-16T16:13:30+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/dev_r9950_GO6_mixing/src/TOP/PISCES/SED/sedwri.F90
r9950 r10323 1 1 MODULE sedwri 2 #if defined key_sed3 2 !!====================================================================== 4 3 !! *** MODULE sedwri *** … … 7 6 USE sed 8 7 USE sedarr 9 USE ioipsl10 USE dianam ! build name of file (routine)8 USE lib_mpp ! distribued memory computing library 9 USE iom 11 10 12 11 IMPLICIT NONE … … 15 14 !! * Accessibility 16 15 PUBLIC sed_wri 17 18 INTEGER :: nised19 INTEGER :: nhorised20 INTEGER :: ndimt5221 INTEGER :: ndimt5122 INTEGER :: ndepsed23 REAL(wp) :: zjulian24 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext5225 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext5126 16 27 17 !! $Id$ … … 43 33 INTEGER, INTENT(in) :: kt 44 34 45 CHARACTER(len = 60) :: clhstnam, clop 46 INTEGER :: ji, jk, js, jw, jn 47 REAL(wp) :: zsto,zout, zdt 48 INTEGER :: iimi, iima, ijmi, ijma,ipk, it, itmod 49 CHARACTER(len = 20) :: cltra , cltrau 50 CHARACTER(len = 80) :: cltral 35 INTEGER :: ji, jj, jk, js, jw, jn 36 INTEGER :: it 37 CHARACTER(len = 20) :: cltra 51 38 REAL(wp) :: zrate 52 39 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta, zflx … … 57 44 ! Initialisation 58 45 ! ----------------- 59 IF( kt == nittrc000 ) ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) )60 61 ! Define frequency of output and means62 zdt = dtsed63 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)64 ELSE ; clop = "x" ! no use of the mask value (require less cpu time)65 ENDIF66 #if defined key_diainstant67 zsto = nwrised * zdt68 clop = "inst("//TRIM(clop)//")"69 #else70 zsto = zdt71 clop = "ave("//TRIM(clop)//")"72 #endif73 zout = nwrised * zdt74 75 ! Define indices of the horizontal output zoom and vertical limit storage76 iimi = 1 ; iima = jpi77 ijmi = 1 ; ijma = jpj78 ipk = jpksed79 80 ! define time axis81 it = kt82 itmod = kt - nitsed000 + 183 84 46 85 47 ! 1. Initilisations 86 48 ! ----------------------------------------------------------------- 87 WRITE(numsed,*) ' ' 88 WRITE(numsed,*) 'sed_wri kt = ', kt 89 WRITE(numsed,*) ' ' 49 IF( ln_timing ) CALL timing_start('sed_wri') 50 ! 51 IF (lwp) WRITE(numsed,*) ' ' 52 IF (lwp) WRITE(numsed,*) 'sed_wri kt = ', kt 53 IF (lwp) WRITE(numsed,*) ' ' 90 54 91 55 ALLOCATE( zdta(jpoce,jpksed) ) ; ALLOCATE( zflx(jpoce,jpwatp1) ) 92 56 57 ! Initialize variables 58 ! -------------------- 59 60 trcsedi(:,:,:,:) = 0.0 61 flxsedi3d(:,:,:,:) = 0.0 62 flxsedi2d(:,:,:) = 0.0 93 63 94 64 ! 2. Back to 2D geometry 95 65 ! ----------------------------------------------------------------- 96 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & 97 & solcp(1:jpoce,1:jpksed,jsopal ) ) 66 DO jn = 1, jpsol 67 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jn) , iarroce(1:jpoce), & 68 & solcp(1:jpoce,1:jpksed,jn ) ) 69 END DO 98 70 99 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & 100 & solcp(1:jpoce,1:jpksed,jsclay ) ) 101 102 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & 103 & solcp(1:jpoce,1:jpksed,jspoc ) ) 104 105 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), & 106 & solcp(1:jpoce,1:jpksed,jscal ) ) 107 108 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), & 109 & pwcp(1:jpoce,1:jpksed,jwsil ) ) 110 111 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6) , iarroce(1:jpoce), & 112 & pwcp(1:jpoce,1:jpksed,jwoxy ) ) 113 114 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7) , iarroce(1:jpoce), & 115 & pwcp(1:jpoce,1:jpksed,jwdic ) ) 116 117 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8) , iarroce(1:jpoce), & 118 & pwcp(1:jpoce,1:jpksed,jwno3 ) ) 119 120 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9) , iarroce(1:jpoce), & 121 & pwcp(1:jpoce,1:jpksed,jwpo4 ) ) 122 123 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10) , iarroce(1:jpoce), & 124 & pwcp(1:jpoce,1:jpksed,jwalk ) ) 125 126 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11) , iarroce(1:jpoce), & 127 & pwcp(1:jpoce,1:jpksed,jwc13 ) ) 128 71 DO jn = 1, jpwat 72 CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,jpsol + jn) , iarroce(1:jpoce), & 73 & pwcp(1:jpoce,1:jpksed,jn ) ) 74 END DO 75 129 76 ! porosity 130 77 zdta(:,:) = 0. 131 78 DO jk = 1, jpksed 132 79 DO ji = 1, jpoce 133 zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji))80 zdta(ji,jk) = -LOG10( hipor(ji,jk) / ( densSW(ji) + rtrn ) + rtrn ) 134 81 ENDDO 135 82 ENDDO 83 136 84 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & 137 85 & zdta(1:jpoce,1:jpksed) ) … … 140 88 & co3por(1:jpoce,1:jpksed) ) 141 89 142 143 ! computation of delta 13C 144 zdta(:,:) = 0. 145 DO jk = 1, jpksed 146 DO ji = 1, jpoce 147 zdta(ji,jk) = ( ( pwcp(ji,jk,jwc13) / pwcp(ji,jk,jwdic) / pdb ) - 1. ) & 148 & * 1000. 149 ENDDO 150 ENDDO 151 CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & 152 & zdta(1:jpoce,1:jpksed) ) 153 154 90 ! flxsedi3d = 0. 155 91 zflx(:,:) = 0. 156 92 ! Calculation of fluxes mol/cm2/s … … 158 94 DO ji = 1, jpoce 159 95 zflx(ji,jw) = ( pwcp(ji,1,jw) - pwcp_dta(ji,jw) ) & 160 & * 1.e -3 * dzkbot(ji) / dtsed96 & * 1.e3 / 1.e2 * dzkbot(ji) / r2dttrc 161 97 ENDDO 162 98 ENDDO 99 163 100 ! Calculation of accumulation rate per dt 164 101 DO js = 1, jpsol 165 zrate = mol_wgt(js) / ( dens * por1(jpksed) ) / dtsed102 zrate = 1.0 / ( denssol * por1(jpksed) ) / r2dttrc 166 103 DO ji = 1, jpoce 167 104 zflx(ji,jpwatp1) = zflx(ji,jpwatp1) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate … … 169 106 ENDDO 170 107 171 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,1), iarroce(1:jpoce), zflx(1:jpoce,1) ) 172 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,2), iarroce(1:jpoce), zflx(1:jpoce,2) ) 173 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,3), iarroce(1:jpoce), zflx(1:jpoce,3) ) 174 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,4), iarroce(1:jpoce), zflx(1:jpoce,4) ) 175 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,5), iarroce(1:jpoce), zflx(1:jpoce,5) ) 176 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,6), iarroce(1:jpoce), zflx(1:jpoce,6) ) 177 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,7), iarroce(1:jpoce), zflx(1:jpoce,8) ) 178 179 180 ! 3. Define NETCDF files and fields at beginning of first time step 181 ! ----------------------------------------------------------------- 182 183 IF( kt == nitsed000 ) THEN 184 185 ! Define the NETCDF files 186 CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian ) 187 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 188 CALL dia_nam ( clhstnam, nwrised, 'sed_T' ) 189 CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, & 190 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 191 & nitsed000-1, zjulian, zdt, nhorised, nised , domain_id=nidom, snc4chunks=snc4set ) 192 CALL histvert( nised,'deptht','Vertic.sed.T levels','m',ipk, profsed, ndepsed, 'down' ) 193 CALL wheneq ( jpi*jpj*ipk, tmasksed, 1, 1., ndext52, ndimt52 ) 194 CALL wheneq ( jpi*jpj, tmasksed(:,:,1), 1, 1., ndext51, ndimt51 ) 195 196 ! Declare all the output fields as NETCDF variables 197 198 DO jn = 1, jptrased 199 cltra = sedtrcd(jn) ! short title for sediment variable 200 cltral = sedtrcl(jn) ! long title for sediment variable 201 cltrau = sedtrcu(jn) ! unit for sediment variable 202 203 CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & 204 & ipk, 1, ipk, ndepsed, 32, clop, zsto, zout ) 205 ENDDO 206 207 ! 3D diagnostic 208 DO jn = 1, jpdia3dsed 209 cltra = seddia3d(jn) ! short title for 3D diagnostic 210 cltral = seddia3l(jn) ! long title for 3D diagnostic 211 cltrau = seddia3u(jn) ! UNIT for 3D diagnostic 212 213 CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & 214 & ipk, 1, ipk, ndepsed, 32, clop, zsto, zout ) 215 ENDDO 216 217 ! Fluxes 218 DO jn = 1, jpdia2dsed 219 cltra = seddia2d(jn) ! short title for 2D diagnostic 220 cltral = seddia2l(jn) ! long title for 2D diagnostic 221 cltrau = seddia2u(jn) ! UNIT for 2D diagnostic 222 223 CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & 224 & 1, 1, 1, -99, 32, clop, zsto, zout ) 225 ENDDO 226 227 228 CALL histend( nised, snc4set ) 229 230 WRITE(numsed,*) 231 WRITE(numsed,*) 'End of NetCDF sediment output file Initialization' 232 233 ENDIF 108 DO jn = 1, jpdia2dsed - 1 109 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,jn), iarroce(1:jpoce), zflx(1:jpoce,jn) ) 110 END DO 111 zflx(:,1) = dzdep(:) / dtsed 112 CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,jpdia2dsed), iarroce(1:jpoce), zflx(1:jpoce,1) ) 234 113 235 114 ! Start writing data … … 237 116 DO jn = 1, jptrased 238 117 cltra = sedtrcd(jn) ! short title for 3D diagnostic 239 CALL histwrite( nised, cltra, it, trcsedi(:,:,:,jn), ndimt52, ndext52)118 CALL iom_put( cltra, trcsedi(:,:,:,jn) ) 240 119 END DO 241 120 242 121 DO jn = 1, jpdia3dsed 243 122 cltra = seddia3d(jn) ! short title for 3D diagnostic 244 CALL histwrite( nised, cltra, it, flxsedi3d(:,:,:,jn), ndimt52, ndext52)123 CALL iom_put( cltra, flxsedi3d(:,:,:,jn) ) 245 124 END DO 246 125 247 126 DO jn = 1, jpdia2dsed 248 249 CALL histwrite( nised, cltra, it, flxsedi2d(:,:,jn ), ndimt51, ndext51)127 cltra = seddia2d(jn) ! short title for 2D diagnostic 128 CALL iom_put( cltra, flxsedi2d(:,:,jn) ) 250 129 END DO 251 130 252 131 253 ! 3. Closing all files 254 ! -------------------- 255 IF( kt == nitsedend ) THEN 256 CALL histclo( nised ) 257 ENDIF 132 DEALLOCATE( zdta ) ; DEALLOCATE( zflx ) 258 133 259 DEALLOCATE( zdta ) ; DEALLOCATE( zflx)134 IF( ln_timing ) CALL timing_stop('sed_wri') 260 135 261 136 END SUBROUTINE sed_wri 262 137 263 #else264 !!======================================================================265 !! MODULE sedwri : Dummy module266 !!======================================================================267 !! $Id$268 CONTAINS269 SUBROUTINE sed_wri( kt ) ! Empty routine270 INTEGER, INTENT(in) :: kt271 WRITE(*,*) 'sed_adv: You should not have seen this print! error?', kt272 END SUBROUTINE sed_wri273 274 !!======================================================================275 #endif276 277 138 END MODULE sedwri
Note: See TracChangeset
for help on using the changeset viewer.