[1179] | 1 | MODULE sedrst |
---|
| 2 | #if defined key_sed |
---|
| 3 | !!====================================================================== |
---|
| 4 | !! *** MODULE sedrst *** |
---|
| 5 | !! Read and write the restart files for sediment |
---|
| 6 | !!====================================================================== |
---|
| 7 | |
---|
| 8 | !!---------------------------------------------------------------------- |
---|
| 9 | !! * Modules used |
---|
| 10 | !! ============== |
---|
| 11 | USE sed |
---|
| 12 | USE sedarr |
---|
| 13 | |
---|
| 14 | |
---|
| 15 | !! * Accessibility |
---|
| 16 | IMPLICIT NONE |
---|
| 17 | PRIVATE |
---|
| 18 | |
---|
| 19 | !! * Accessibility |
---|
| 20 | PUBLIC sed_rst_read |
---|
| 21 | PUBLIC sed_rst_write |
---|
| 22 | |
---|
| 23 | !! * Module variables |
---|
| 24 | INTEGER, PUBLIC :: numrsr, numrsw !: logical unit for sed restart (read and write) |
---|
| 25 | |
---|
| 26 | |
---|
| 27 | CONTAINS |
---|
| 28 | |
---|
| 29 | |
---|
| 30 | SUBROUTINE sed_rst_read |
---|
| 31 | !!---------------------------------------------------------------------- |
---|
| 32 | !! *** ROUTINE sed_rst_read *** |
---|
| 33 | !! |
---|
| 34 | !! ** Purpose : Initialization of sediment module |
---|
| 35 | !! - sets initial sediment composition |
---|
| 36 | !! ( only clay or reading restart file ) |
---|
| 37 | !! |
---|
| 38 | !! History : |
---|
| 39 | !! ! 06-07 (C. Ethe) original |
---|
| 40 | !!---------------------------------------------------------------------- |
---|
| 41 | !! * Modules used |
---|
| 42 | USE iom |
---|
| 43 | |
---|
| 44 | !! * local declarations |
---|
| 45 | INTEGER :: & |
---|
| 46 | ji, jk, jn |
---|
| 47 | REAL(wp), DIMENSION(jpi,jpj,jpksed,jptrased) :: & |
---|
| 48 | zdta |
---|
| 49 | |
---|
| 50 | REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & |
---|
| 51 | zhipor |
---|
| 52 | |
---|
| 53 | REAL(wp) :: zkt |
---|
| 54 | CHARACTER(len = 20) :: cltra |
---|
| 55 | !-------------------------------------------------------------------- |
---|
| 56 | |
---|
| 57 | |
---|
| 58 | WRITE(numsed,*) ' ' |
---|
| 59 | WRITE(numsed,*) ' Initilization of Sediment components from restart' |
---|
| 60 | WRITE(numsed,*) ' ' |
---|
| 61 | |
---|
| 62 | ALLOCATE( zhipor(jpoce,jpksed) ) |
---|
| 63 | |
---|
| 64 | CALL iom_open( 'restart_sed', numrsr, kiolib = jprstlib ) |
---|
| 65 | CALL iom_get( numrsr, 'kt' , zkt ) ! time-step |
---|
| 66 | |
---|
| 67 | DO jn = 1, jptrased - 1 |
---|
| 68 | cltra = sedtrc3d(jn) |
---|
| 69 | CALL iom_get( numrsr, jpdom_unknown, cltra, zdta(:,:,:,jn), & |
---|
| 70 | & kstart=(/1,1,1/), kcount=(/jpi,jpj,jpksed/) ) |
---|
| 71 | ENDDO |
---|
| 72 | |
---|
| 73 | |
---|
| 74 | CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsopal), & |
---|
| 75 | & zdta(1:jpi,1:jpj,1:jpksed,1), iarroce(1:jpoce) ) |
---|
| 76 | |
---|
| 77 | CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jsclay), & |
---|
| 78 | & zdta(1:jpi,1:jpj,1:jpksed,2), iarroce(1:jpoce) ) |
---|
| 79 | |
---|
| 80 | CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jspoc), & |
---|
| 81 | & zdta(1:jpi,1:jpj,1:jpksed,3), iarroce(1:jpoce) ) |
---|
| 82 | |
---|
| 83 | CALL pack_arr( jpoce, solcp(1:jpoce,1:jpksed,jscal), & |
---|
| 84 | & zdta(1:jpi,1:jpj,1:jpksed,4), iarroce(1:jpoce) ) |
---|
| 85 | |
---|
| 86 | CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwsil), & |
---|
| 87 | & zdta(1:jpi,1:jpj,1:jpksed,5), iarroce(1:jpoce) ) |
---|
| 88 | |
---|
| 89 | |
---|
| 90 | CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwoxy), & |
---|
| 91 | & zdta(1:jpi,1:jpj,1:jpksed,6), iarroce(1:jpoce) ) |
---|
| 92 | |
---|
| 93 | |
---|
| 94 | CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwdic), & |
---|
| 95 | & zdta(1:jpi,1:jpj,1:jpksed,7), iarroce(1:jpoce) ) |
---|
| 96 | |
---|
| 97 | CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwno3), & |
---|
| 98 | & zdta(1:jpi,1:jpj,1:jpksed,8), iarroce(1:jpoce) ) |
---|
| 99 | |
---|
| 100 | CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwpo4), & |
---|
| 101 | & zdta(1:jpi,1:jpj,1:jpksed,9), iarroce(1:jpoce) ) |
---|
| 102 | |
---|
| 103 | CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwalk), & |
---|
| 104 | & zdta(1:jpi,1:jpj,1:jpksed,10), iarroce(1:jpoce) ) |
---|
| 105 | |
---|
| 106 | CALL pack_arr( jpoce, pwcp(1:jpoce,1:jpksed,jwc13), & |
---|
| 107 | & zdta(1:jpi,1:jpj,1:jpksed,11), iarroce(1:jpoce) ) |
---|
| 108 | |
---|
| 109 | zhipor(:,:) = 0. |
---|
| 110 | CALL pack_arr( jpoce, zhipor(1:jpoce,1:jpksed), & |
---|
| 111 | & zdta(1:jpi,1:jpj,1:jpksed,12), iarroce(1:jpoce) ) |
---|
| 112 | |
---|
| 113 | ! Initialization of [h+] in mol/kg |
---|
| 114 | DO jk = 1, jpksed |
---|
| 115 | DO ji = 1, jpoce |
---|
| 116 | hipor (ji,jk) = 10.**( -1. * zhipor(ji,jk) ) |
---|
| 117 | ENDDO |
---|
| 118 | ENDDO |
---|
| 119 | |
---|
| 120 | CALL pack_arr( jpoce, co3por(1:jpoce,1:jpksed), & |
---|
| 121 | & zdta(1:jpi,1:jpj,1:jpksed,13), iarroce(1:jpoce) ) |
---|
| 122 | |
---|
| 123 | ! Initialization of sediment composant only ie jk=2 to jk=jpksed |
---|
| 124 | ! ( nothing in jk=1) |
---|
| 125 | solcp(1:jpoce,1,:) = 0. |
---|
| 126 | pwcp (1:jpoce,1,:) = 0. |
---|
| 127 | |
---|
| 128 | DEALLOCATE( zhipor ) |
---|
| 129 | |
---|
| 130 | END SUBROUTINE sed_rst_read |
---|
| 131 | |
---|
| 132 | |
---|
| 133 | SUBROUTINE sed_rst_write( kt ) |
---|
| 134 | !!---------------------------------------------------------------------- |
---|
| 135 | !! *** ROUTINE sed_rst_write *** |
---|
| 136 | !! |
---|
| 137 | !! ** Purpose : save field which are necessary for sediment restart |
---|
| 138 | !! |
---|
| 139 | !! History : |
---|
| 140 | !! ! 06-07 (C. Ethe) original |
---|
| 141 | !!---------------------------------------------------------------------- |
---|
| 142 | !!* Modules used |
---|
| 143 | USE ioipsl |
---|
| 144 | !! *Arguments |
---|
| 145 | INTEGER, INTENT(in) :: kt ! number of iteration |
---|
| 146 | !! * local declarations |
---|
| 147 | |
---|
| 148 | CHARACTER (len=50) :: clname,cln |
---|
| 149 | |
---|
| 150 | INTEGER :: & |
---|
| 151 | ic,jc,jn, & |
---|
| 152 | itime |
---|
| 153 | |
---|
| 154 | REAL(wp) :: & |
---|
| 155 | zdate0 |
---|
| 156 | |
---|
| 157 | REAL(wp), DIMENSION(1) :: & |
---|
| 158 | zinfo |
---|
| 159 | |
---|
| 160 | CHARACTER(len = 20) :: cltra |
---|
| 161 | |
---|
| 162 | INTEGER :: ji, jk |
---|
| 163 | REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zdta |
---|
| 164 | !! ----------------------------------------------------------------------- |
---|
| 165 | |
---|
| 166 | ALLOCATE( zdta(jpoce,jpksed) ) |
---|
| 167 | |
---|
| 168 | IF( MOD(kt,nstock) == 0 .OR. kt == nitsedend ) THEN |
---|
| 169 | |
---|
| 170 | !! 0. initialisations |
---|
| 171 | !! ------------------ |
---|
| 172 | |
---|
| 173 | IF(lwp) WRITE(numsed,*) ' ' |
---|
| 174 | IF(lwp) WRITE(numsed,*) 'sed_rst_write : write the sediment restart file in NetCDF format ', & |
---|
| 175 | 'at it= ',kt |
---|
| 176 | IF(lwp) WRITE(numsed,*) '~~~~~~~~~' |
---|
| 177 | |
---|
| 178 | !! 1. WRITE in nutwrs |
---|
| 179 | !! ------------------ |
---|
| 180 | |
---|
| 181 | ic = 1 |
---|
| 182 | DO jc = 1,16 |
---|
| 183 | IF( cexper(jc:jc) /= ' ') ic = jc |
---|
| 184 | END DO |
---|
| 185 | WRITE( cln,'("_",i4.4,i2.2,i2.2,"_restart.sed")') nyear, nmonth, nday |
---|
| 186 | clname = cexper(1:ic)//cln |
---|
| 187 | itime = 0 |
---|
| 188 | CALL ymds2ju( nyear, nmonth, nday, 0.0, zdate0 ) |
---|
| 189 | CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpksed, dz, & |
---|
| 190 | & clname, itime, zdate0, dtsed*nstock, numrsw, domain_id=nidom ) |
---|
| 191 | zinfo(1) = REAL( kt) |
---|
| 192 | CALL restput( numrsw, 'kt', 1,1, 1,0, zinfo ) |
---|
| 193 | |
---|
| 194 | |
---|
| 195 | |
---|
| 196 | ! Back to 2D geometry |
---|
| 197 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,1) , iarroce(1:jpoce), & |
---|
| 198 | & solcp(1:jpoce,1:jpksed,jsopal ) ) |
---|
| 199 | |
---|
| 200 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,2) , iarroce(1:jpoce), & |
---|
| 201 | & solcp(1:jpoce,1:jpksed,jsclay ) ) |
---|
| 202 | |
---|
| 203 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,3) , iarroce(1:jpoce), & |
---|
| 204 | & solcp(1:jpoce,1:jpksed,jspoc ) ) |
---|
| 205 | |
---|
| 206 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,4) , iarroce(1:jpoce), & |
---|
| 207 | & solcp(1:jpoce,1:jpksed,jscal ) ) |
---|
| 208 | |
---|
| 209 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,5) , iarroce(1:jpoce), & |
---|
| 210 | & pwcp(1:jpoce,1:jpksed,jwsil ) ) |
---|
| 211 | |
---|
| 212 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,6) , iarroce(1:jpoce), & |
---|
| 213 | & pwcp(1:jpoce,1:jpksed,jwoxy ) ) |
---|
| 214 | |
---|
| 215 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,7) , iarroce(1:jpoce), & |
---|
| 216 | & pwcp(1:jpoce,1:jpksed,jwdic ) ) |
---|
| 217 | |
---|
| 218 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,8) , iarroce(1:jpoce), & |
---|
| 219 | & pwcp(1:jpoce,1:jpksed,jwno3 ) ) |
---|
| 220 | |
---|
| 221 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,9) , iarroce(1:jpoce), & |
---|
| 222 | & pwcp(1:jpoce,1:jpksed,jwpo4 ) ) |
---|
| 223 | |
---|
| 224 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,10) , iarroce(1:jpoce), & |
---|
| 225 | & pwcp(1:jpoce,1:jpksed,jwalk ) ) |
---|
| 226 | |
---|
| 227 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,11) , iarroce(1:jpoce), & |
---|
| 228 | & pwcp(1:jpoce,1:jpksed,jwc13 ) ) |
---|
| 229 | |
---|
| 230 | ! porosity |
---|
| 231 | zdta(:,:) = 0. |
---|
| 232 | DO jk = 1, jpksed |
---|
| 233 | DO ji = 1, jpoce |
---|
| 234 | zdta(ji,jk) = -LOG10( hipor(ji,jk) / densSW(ji) ) |
---|
| 235 | ENDDO |
---|
| 236 | ENDDO |
---|
| 237 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,12) , iarroce(1:jpoce), & |
---|
| 238 | & zdta(1:jpoce,1:jpksed) ) |
---|
| 239 | |
---|
| 240 | CALL unpack_arr( jpoce, trcsedi(1:jpi,1:jpj,1:jpksed,13) , iarroce(1:jpoce), & |
---|
| 241 | & co3por(1:jpoce,1:jpksed) ) |
---|
| 242 | |
---|
| 243 | ! prognostic variables |
---|
| 244 | ! -------------------- |
---|
| 245 | |
---|
| 246 | |
---|
| 247 | DO jn = 1, jptrased - 1 |
---|
| 248 | cltra = sedtrc3d(jn) |
---|
| 249 | CALL restput( numrsw, cltra, jpi, jpj, jpksed, 0, trcsedi(:,:,:,jn) ) |
---|
| 250 | ENDDO |
---|
| 251 | |
---|
| 252 | CALL restclo( numrsw ) |
---|
| 253 | |
---|
| 254 | ENDIF |
---|
| 255 | |
---|
| 256 | DEALLOCATE( zdta ) |
---|
| 257 | |
---|
| 258 | END SUBROUTINE sed_rst_write |
---|
| 259 | #else |
---|
| 260 | !!====================================================================== |
---|
| 261 | !! MODULE sedrst : Dummy module |
---|
| 262 | !!====================================================================== |
---|
| 263 | |
---|
| 264 | #endif |
---|
| 265 | |
---|
| 266 | END MODULE sedrst |
---|