[3443] | 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 | USE ioipsl |
---|
| 10 | USE dianam ! build name of file (routine) |
---|
| 11 | |
---|
| 12 | IMPLICIT NONE |
---|
| 13 | PRIVATE |
---|
| 14 | |
---|
| 15 | !! * Accessibility |
---|
| 16 | PUBLIC sed_wri |
---|
| 17 | |
---|
| 18 | INTEGER :: nised |
---|
| 19 | INTEGER :: nhorised |
---|
| 20 | INTEGER :: ndimt52 |
---|
| 21 | INTEGER :: ndimt51 |
---|
| 22 | INTEGER :: ndepsed |
---|
| 23 | REAL(wp) :: zjulian |
---|
| 24 | INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext52 |
---|
| 25 | INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext51 |
---|
| 26 | |
---|
[5215] | 27 | !! $Id$ |
---|
[3443] | 28 | CONTAINS |
---|
| 29 | |
---|
| 30 | !!---------------------------------------------------------------------- |
---|
| 31 | !! NetCDF output file |
---|
| 32 | !!---------------------------------------------------------------------- |
---|
| 33 | SUBROUTINE sed_wri( kt ) |
---|
| 34 | !!---------------------------------------------------------------------- |
---|
| 35 | !! *** ROUTINE sed_wri *** |
---|
| 36 | !! |
---|
| 37 | !! ** Purpose : output of sediment passive tracer |
---|
| 38 | !! |
---|
| 39 | !! History : |
---|
| 40 | !! ! 06-07 (C. Ethe) original |
---|
| 41 | !!---------------------------------------------------------------------- |
---|
| 42 | |
---|
| 43 | INTEGER, INTENT(in) :: kt |
---|
| 44 | |
---|
| 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 |
---|
| 51 | REAL(wp) :: zrate |
---|
| 52 | REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zdta, zflx |
---|
| 53 | |
---|
| 54 | !!------------------------------------------------------------------- |
---|
| 55 | |
---|
| 56 | |
---|
| 57 | ! Initialisation |
---|
| 58 | ! ----------------- |
---|
| 59 | IF( kt == nittrc000 ) ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) ) |
---|
| 60 | |
---|
| 61 | ! Define frequency of output and means |
---|
| 62 | zdt = dtsed |
---|
| 63 | 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 | ENDIF |
---|
| 66 | #if defined key_diainstant |
---|
| 67 | zsto = nwrised * zdt |
---|
| 68 | clop = "inst("//TRIM(clop)//")" |
---|
| 69 | #else |
---|
| 70 | zsto = zdt |
---|
| 71 | clop = "ave("//TRIM(clop)//")" |
---|
| 72 | #endif |
---|
| 73 | zout = nwrised * zdt |
---|
| 74 | |
---|
| 75 | ! Define indices of the horizontal output zoom and vertical limit storage |
---|
| 76 | iimi = 1 ; iima = jpi |
---|
| 77 | ijmi = 1 ; ijma = jpj |
---|
| 78 | ipk = jpksed |
---|
| 79 | |
---|
| 80 | ! define time axis |
---|
| 81 | it = kt |
---|
| 82 | itmod = kt - nitsed000 + 1 |
---|
| 83 | |
---|
| 84 | |
---|
| 85 | ! 1. Initilisations |
---|
| 86 | ! ----------------------------------------------------------------- |
---|
| 87 | WRITE(numsed,*) ' ' |
---|
| 88 | WRITE(numsed,*) 'sed_wri kt = ', kt |
---|
| 89 | WRITE(numsed,*) ' ' |
---|
| 90 | |
---|
| 91 | ALLOCATE( zdta(jpoce,jpksed) ) ; ALLOCATE( zflx(jpoce,jpwatp1) ) |
---|
| 92 | |
---|
| 93 | |
---|
| 94 | ! 2. Back to 2D geometry |
---|
| 95 | ! ----------------------------------------------------------------- |
---|
| 96 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & |
---|
| 97 | & solcp(1:jpoce,1:jpksed,jsopal ) ) |
---|
| 98 | |
---|
| 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 | |
---|
| 129 | ! porosity |
---|
| 130 | zdta(:,:) = 0. |
---|
| 131 | DO jk = 1, jpksed |
---|
| 132 | DO ji = 1, jpoce |
---|
| 133 | zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) ) |
---|
| 134 | ENDDO |
---|
| 135 | ENDDO |
---|
| 136 | CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & |
---|
| 137 | & zdta(1:jpoce,1:jpksed) ) |
---|
| 138 | |
---|
| 139 | CALL unpack_arr( jpoce, flxsedi3d(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & |
---|
| 140 | & co3por(1:jpoce,1:jpksed) ) |
---|
| 141 | |
---|
| 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 | |
---|
| 155 | zflx(:,:) = 0. |
---|
| 156 | ! Calculation of fluxes mol/cm2/s |
---|
| 157 | DO jw = 1, jpwat |
---|
| 158 | DO ji = 1, jpoce |
---|
| 159 | zflx(ji,jw) = ( pwcp(ji,1,jw) - pwcp_dta(ji,jw) ) & |
---|
| 160 | & * 1.e-3 * dzkbot(ji) / dtsed |
---|
| 161 | ENDDO |
---|
| 162 | ENDDO |
---|
| 163 | ! Calculation of accumulation rate per dt |
---|
| 164 | DO js = 1, jpsol |
---|
| 165 | zrate = mol_wgt(js) / ( dens * por1(jpksed) ) / dtsed |
---|
| 166 | DO ji = 1, jpoce |
---|
| 167 | zflx(ji,jpwatp1) = zflx(ji,jpwatp1) + ( tosed(ji,js) - fromsed(ji,js) ) * zrate |
---|
| 168 | ENDDO |
---|
| 169 | ENDDO |
---|
| 170 | |
---|
| 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 |
---|
| 234 | |
---|
| 235 | ! Start writing data |
---|
| 236 | ! --------------------- |
---|
| 237 | DO jn = 1, jptrased |
---|
| 238 | cltra = sedtrcd(jn) ! short title for 3D diagnostic |
---|
| 239 | CALL histwrite( nised, cltra, it, trcsedi(:,:,:,jn), ndimt52, ndext52 ) |
---|
| 240 | END DO |
---|
| 241 | |
---|
| 242 | DO jn = 1, jpdia3dsed |
---|
| 243 | cltra = seddia3d(jn) ! short title for 3D diagnostic |
---|
| 244 | CALL histwrite( nised, cltra, it, flxsedi3d(:,:,:,jn), ndimt52, ndext52 ) |
---|
| 245 | END DO |
---|
| 246 | |
---|
| 247 | DO jn = 1, jpdia2dsed |
---|
| 248 | cltra = seddia2d(jn) ! short title for 2D diagnostic |
---|
| 249 | CALL histwrite( nised, cltra, it, flxsedi2d(:,:,jn ), ndimt51, ndext51 ) |
---|
| 250 | END DO |
---|
| 251 | |
---|
| 252 | |
---|
| 253 | ! 3. Closing all files |
---|
| 254 | ! -------------------- |
---|
| 255 | IF( kt == nitsedend ) THEN |
---|
| 256 | CALL histclo( nised ) |
---|
| 257 | ENDIF |
---|
| 258 | |
---|
| 259 | DEALLOCATE( zdta ) ; DEALLOCATE( zflx ) |
---|
| 260 | |
---|
| 261 | END SUBROUTINE sed_wri |
---|
| 262 | |
---|
| 263 | #else |
---|
| 264 | !!====================================================================== |
---|
| 265 | !! MODULE sedwri : Dummy module |
---|
| 266 | !!====================================================================== |
---|
[5215] | 267 | !! $Id$ |
---|
[3443] | 268 | CONTAINS |
---|
| 269 | SUBROUTINE sed_wri( kt ) ! Empty routine |
---|
| 270 | INTEGER, INTENT(in) :: kt |
---|
| 271 | WRITE(*,*) 'sed_adv: You should not have seen this print! error?', kt |
---|
| 272 | END SUBROUTINE sed_wri |
---|
| 273 | |
---|
| 274 | !!====================================================================== |
---|
| 275 | #endif |
---|
| 276 | |
---|
| 277 | END MODULE sedwri |
---|