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