[1179] | 1 | MODULE sedwri |
---|
| 2 | #if defined key_sed |
---|
| 3 | !!====================================================================== |
---|
| 4 | !! *** MODULE sedwri *** |
---|
| 5 | !! Sediment diagnostics : write sediment output files |
---|
| 6 | !!====================================================================== |
---|
| 7 | USE sed |
---|
| 8 | USE sedarr |
---|
| 9 | |
---|
| 10 | IMPLICIT NONE |
---|
| 11 | PRIVATE |
---|
| 12 | |
---|
| 13 | !! * Accessibility |
---|
| 14 | PUBLIC sed_wri |
---|
| 15 | |
---|
| 16 | CONTAINS |
---|
| 17 | |
---|
| 18 | !!---------------------------------------------------------------------- |
---|
| 19 | !! NetCDF output file |
---|
| 20 | !!---------------------------------------------------------------------- |
---|
| 21 | SUBROUTINE sed_wri( kt ) |
---|
| 22 | !!---------------------------------------------------------------------- |
---|
| 23 | !! *** ROUTINE sed_wri *** |
---|
| 24 | !! |
---|
| 25 | !! ** Purpose : output of sediment passive tracer |
---|
| 26 | !! |
---|
| 27 | !! History : |
---|
| 28 | !! ! 06-07 (C. Ethe) original |
---|
| 29 | !!---------------------------------------------------------------------- |
---|
| 30 | !! * Local variables |
---|
| 31 | USE ioipsl |
---|
| 32 | USE dianam ! build name of file (routine) |
---|
| 33 | |
---|
| 34 | INTEGER, INTENT(in) :: kt |
---|
| 35 | |
---|
| 36 | CHARACTER(len = 60) :: clhstnam, clop |
---|
| 37 | INTEGER , SAVE :: nised, nhorised, ndimt52, ndimt51, ndepsed |
---|
| 38 | REAL(wp), SAVE :: zjulian |
---|
| 39 | INTEGER , DIMENSION(jpij*jpksed) , SAVE :: ndext52 |
---|
| 40 | INTEGER , DIMENSION(jpij) , SAVE :: ndext51 |
---|
| 41 | REAL(wp) :: zsto,zout, zdt |
---|
| 42 | INTEGER :: iimi, iima, ijmi, ijma,ipk, it |
---|
| 43 | INTEGER :: jn |
---|
| 44 | CHARACTER(len = 20) :: cltra , cltrau |
---|
| 45 | CHARACTER(len = 80) :: cltral |
---|
| 46 | |
---|
| 47 | INTEGER :: ji, jk, js, jw |
---|
| 48 | REAL(wp) :: zrate |
---|
| 49 | REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zdta, zflx |
---|
| 50 | |
---|
| 51 | !!------------------------------------------------------------------- |
---|
| 52 | |
---|
| 53 | |
---|
| 54 | ! Initialisation |
---|
| 55 | ! ----------------- |
---|
| 56 | |
---|
| 57 | |
---|
| 58 | ! Define frequency of output and means |
---|
| 59 | zdt = dtsed |
---|
[1312] | 60 | IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) |
---|
| 61 | ELSE ; clop = "x" ! no use of the mask value (require less cpu time) |
---|
| 62 | ENDIF |
---|
[1179] | 63 | #if defined key_diainstant |
---|
| 64 | zsto = nwrised * zdt |
---|
[1312] | 65 | clop = "inst("//TRIM(clop)//")" |
---|
[1179] | 66 | #else |
---|
| 67 | zsto = zdt |
---|
[1312] | 68 | clop = "ave("//TRIM(clop)//")" |
---|
[1179] | 69 | #endif |
---|
| 70 | zout = nwrised * zdt |
---|
| 71 | |
---|
| 72 | ! Define indices of the horizontal output zoom and vertical limit storage |
---|
| 73 | iimi = 1 ; iima = jpi |
---|
| 74 | ijmi = 1 ; ijma = jpj |
---|
| 75 | ipk = jpksed |
---|
| 76 | |
---|
| 77 | ! define time axis |
---|
| 78 | it = kt - nitsed000 + 1 |
---|
| 79 | |
---|
| 80 | |
---|
| 81 | ! 1. Initilisations |
---|
| 82 | ! ----------------------------------------------------------------- |
---|
| 83 | WRITE(numsed,*) ' ' |
---|
| 84 | WRITE(numsed,*) 'sed_wri kt = ', kt |
---|
| 85 | WRITE(numsed,*) ' ' |
---|
| 86 | |
---|
| 87 | ALLOCATE( zdta(jpoce,jpksed) ) ; ALLOCATE( zflx(jpoce,jpwatp1) ) |
---|
| 88 | |
---|
| 89 | |
---|
| 90 | ! 2. Back to 2D geometry |
---|
| 91 | ! ----------------------------------------------------------------- |
---|
| 92 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & |
---|
| 93 | & solcp(1:jpoce,1:jpksed,jsopal ) ) |
---|
| 94 | |
---|
| 95 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & |
---|
| 96 | & solcp(1:jpoce,1:jpksed,jsclay ) ) |
---|
| 97 | |
---|
| 98 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & |
---|
| 99 | & solcp(1:jpoce,1:jpksed,jspoc ) ) |
---|
| 100 | |
---|
| 101 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), & |
---|
| 102 | & solcp(1:jpoce,1:jpksed,jscal ) ) |
---|
| 103 | |
---|
| 104 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), & |
---|
| 105 | & pwcp(1:jpoce,1:jpksed,jwsil ) ) |
---|
| 106 | |
---|
| 107 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6) , iarroce(1:jpoce), & |
---|
| 108 | & pwcp(1:jpoce,1:jpksed,jwoxy ) ) |
---|
| 109 | |
---|
| 110 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7) , iarroce(1:jpoce), & |
---|
| 111 | & pwcp(1:jpoce,1:jpksed,jwdic ) ) |
---|
| 112 | |
---|
| 113 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8) , iarroce(1:jpoce), & |
---|
| 114 | & pwcp(1:jpoce,1:jpksed,jwno3 ) ) |
---|
| 115 | |
---|
| 116 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9) , iarroce(1:jpoce), & |
---|
| 117 | & pwcp(1:jpoce,1:jpksed,jwpo4 ) ) |
---|
| 118 | |
---|
| 119 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10) , iarroce(1:jpoce), & |
---|
| 120 | & pwcp(1:jpoce,1:jpksed,jwalk ) ) |
---|
| 121 | |
---|
| 122 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11) , iarroce(1:jpoce), & |
---|
| 123 | & pwcp(1:jpoce,1:jpksed,jwc13 ) ) |
---|
| 124 | |
---|
| 125 | ! porosity |
---|
| 126 | zdta(:,:) = 0. |
---|
| 127 | DO jk = 1, jpksed |
---|
| 128 | DO ji = 1, jpoce |
---|
| 129 | zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) ) |
---|
| 130 | ENDDO |
---|
| 131 | ENDDO |
---|
[1250] | 132 | CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & |
---|
[1179] | 133 | & zdta(1:jpoce,1:jpksed) ) |
---|
| 134 | |
---|
[1250] | 135 | CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & |
---|
[1179] | 136 | & co3por(1:jpoce,1:jpksed) ) |
---|
| 137 | |
---|
| 138 | |
---|
| 139 | ! computation of delta 13C |
---|
| 140 | zdta(:,:) = 0. |
---|
| 141 | DO jk = 1, jpksed |
---|
| 142 | DO ji = 1, jpoce |
---|
| 143 | zdta(ji,jk) = ( ( pwcp(ji,jk,jwc13) / pwcp(ji,jk,jwdic) / pdb ) - 1. ) & |
---|
| 144 | & * 1000. |
---|
| 145 | ENDDO |
---|
| 146 | ENDDO |
---|
[1250] | 147 | CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & |
---|
[1179] | 148 | & zdta(1:jpoce,1:jpksed) ) |
---|
| 149 | |
---|
| 150 | |
---|
| 151 | zflx(:,:) = 0. |
---|
| 152 | ! Calculation of fluxes mol/cm2/s |
---|
| 153 | DO jw = 1, jpwat |
---|
| 154 | DO ji = 1, jpoce |
---|
| 155 | zflx(ji,jw) = ( pwcp(ji,1,jw) - pwcp_dta(ji,jw) ) & |
---|
| 156 | & * 1.e-3 * dzkbot(ji) / dtsed |
---|
| 157 | ENDDO |
---|
| 158 | ENDDO |
---|
| 159 | ! Calculation of accumulation rate per dt |
---|
| 160 | DO js = 1, jpsol |
---|
| 161 | zrate = mol_wgt(js) / ( dens * por1(jpksed) ) / dtsed |
---|
| 162 | DO ji = 1, jpoce |
---|
| 163 | zflx(ji,jpwatp1) = zflx(ji,jpwatp1) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate |
---|
| 164 | ENDDO |
---|
| 165 | ENDDO |
---|
| 166 | |
---|
[1250] | 167 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,1), iarroce(1:jpoce), zflx(1:jpoce,1) ) |
---|
| 168 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,2), iarroce(1:jpoce), zflx(1:jpoce,2) ) |
---|
| 169 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,3), iarroce(1:jpoce), zflx(1:jpoce,3) ) |
---|
| 170 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,4), iarroce(1:jpoce), zflx(1:jpoce,4) ) |
---|
| 171 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,5), iarroce(1:jpoce), zflx(1:jpoce,5) ) |
---|
| 172 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,6), iarroce(1:jpoce), zflx(1:jpoce,6) ) |
---|
| 173 | CALL unpack_arr( jpoce, flxsedi2d(1:jpi,1:jpj,7), iarroce(1:jpoce), zflx(1:jpoce,8) ) |
---|
[1179] | 174 | |
---|
| 175 | |
---|
| 176 | ! 3. Define NETCDF files and fields at beginning of first time step |
---|
| 177 | ! ----------------------------------------------------------------- |
---|
| 178 | |
---|
| 179 | IF( kt == nitsed000 ) THEN |
---|
| 180 | |
---|
| 181 | ! Define the NETCDF files |
---|
[1310] | 182 | CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian ) |
---|
| 183 | zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment |
---|
[1179] | 184 | CALL dia_nam ( clhstnam, nwrised, 'sed_T' ) |
---|
| 185 | CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, & |
---|
| 186 | & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & |
---|
| 187 | & 0, zjulian, zdt, nhorised, nised , domain_id=nidom ) |
---|
| 188 | CALL histvert( nised,'deptht','Vertic.sed.T levels','m',ipk, profsed, ndepsed ) |
---|
| 189 | CALL wheneq ( jpi*jpj*ipk, tmasksed, 1, 1., ndext52, ndimt52 ) |
---|
| 190 | CALL wheneq ( jpi*jpj, tmasksed(:,:,1), 1, 1., ndext51, ndimt51 ) |
---|
| 191 | |
---|
| 192 | ! Declare all the output fields as NETCDF variables |
---|
| 193 | |
---|
| 194 | DO jn = 1, jptrased |
---|
[1250] | 195 | cltra = sedtrcd(jn) ! short title for sediment variable |
---|
| 196 | cltral = sedtrcl(jn) ! long title for sediment variable |
---|
| 197 | cltrau = sedtrcu(jn) ! unit for sediment variable |
---|
[1179] | 198 | |
---|
| 199 | CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & |
---|
| 200 | & ipk, 1, ipk, ndepsed, 32, clop, zsto, zout ) |
---|
| 201 | ENDDO |
---|
| 202 | |
---|
[1250] | 203 | ! 3D diagnostic |
---|
| 204 | DO jn = 1, jpdia3dsed |
---|
| 205 | cltra = seddia3d(jn) ! short title for 3D diagnostic |
---|
| 206 | cltral = seddia3l(jn) ! long title for 3D diagnostic |
---|
| 207 | cltrau = seddia3u(jn) ! UNIT for 3D diagnostic |
---|
| 208 | |
---|
| 209 | CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & |
---|
| 210 | & ipk, 1, ipk, ndepsed, 32, clop, zsto, zout ) |
---|
| 211 | ENDDO |
---|
| 212 | |
---|
[1179] | 213 | !Fluxes |
---|
[1250] | 214 | DO jn = 1, jpdia2dsed |
---|
| 215 | cltra = seddia2d(jn) ! short title for 2D diagnostic |
---|
| 216 | cltral = seddia2l(jn) ! long title for 2D diagnostic |
---|
| 217 | cltrau = seddia2u(jn) ! UNIT for 2D diagnostic |
---|
[1179] | 218 | |
---|
| 219 | CALL histdef( nised, cltra,cltral,cltrau, jpi, jpj, nhorised, & |
---|
| 220 | & 1, 1, 1, -99, 32, clop, zsto, zout ) |
---|
| 221 | ENDDO |
---|
| 222 | |
---|
| 223 | |
---|
| 224 | CALL histend( nised ) |
---|
| 225 | |
---|
| 226 | WRITE(numsed,*) |
---|
| 227 | WRITE(numsed,*) 'End of NetCDF sediment output file Initialization' |
---|
| 228 | |
---|
| 229 | ELSE |
---|
| 230 | |
---|
| 231 | |
---|
| 232 | ! Start writing data |
---|
| 233 | ! --------------------- |
---|
| 234 | DO jn = 1, jptrased |
---|
[1250] | 235 | cltra = sedtrcd(jn) ! short title for 3D diagnostic |
---|
[1179] | 236 | CALL histwrite( nised, cltra, it, trcsedi(:,:,:,jn), ndimt52, ndext52 ) |
---|
| 237 | END DO |
---|
| 238 | |
---|
[1250] | 239 | DO jn = 1, jpdia3dsed |
---|
| 240 | cltra = seddia3d(jn) ! short title for 3D diagnostic |
---|
| 241 | CALL histwrite( nised, cltra, it, flxsedi3d(:,:,:,jn), ndimt52, ndext52 ) |
---|
[1179] | 242 | END DO |
---|
| 243 | |
---|
[1250] | 244 | DO jn = 1, jpdia2dsed |
---|
| 245 | cltra = seddia2d(jn) ! short title for 2D diagnostic |
---|
| 246 | CALL histwrite( nised, cltra, it, flxsedi2d(:,:,jn ), ndimt51, ndext51 ) |
---|
| 247 | END DO |
---|
[1179] | 248 | |
---|
[1250] | 249 | |
---|
[1179] | 250 | !! |
---|
| 251 | !! synchronise FILE |
---|
| 252 | ! |
---|
[1317] | 253 | IF( MOD( it, nwrised ) == 0 ) THEN |
---|
[1179] | 254 | WRITE(numsed,*) '**** sedwri : write NetCDF aditional arrays' |
---|
| 255 | CALL histsync( nised ) |
---|
| 256 | ENDIF |
---|
| 257 | |
---|
| 258 | ENDIF |
---|
| 259 | |
---|
| 260 | ! 3. Closing all files |
---|
| 261 | ! -------------------- |
---|
| 262 | IF( kt == nitsedend ) THEN |
---|
| 263 | CALL histclo( nised ) |
---|
| 264 | ENDIF |
---|
| 265 | |
---|
| 266 | DEALLOCATE( zdta ) ; DEALLOCATE( zflx ) |
---|
| 267 | |
---|
| 268 | END SUBROUTINE sed_wri |
---|
| 269 | |
---|
| 270 | #else |
---|
| 271 | !!====================================================================== |
---|
[1250] | 272 | !! MODULE sedwri : Dummy module |
---|
[1179] | 273 | !!====================================================================== |
---|
[1250] | 274 | CONTAINS |
---|
| 275 | SUBROUTINE sed_wri( kt ) ! Empty routine |
---|
| 276 | INTEGER, INTENT(in) :: kt |
---|
| 277 | WRITE(*,*) 'sed_adv: You should not have seen this print! error?', kt |
---|
| 278 | END SUBROUTINE sed_wri |
---|
[1179] | 279 | |
---|
[1250] | 280 | !!====================================================================== |
---|
[1179] | 281 | #endif |
---|
| 282 | |
---|
| 283 | END MODULE sedwri |
---|