Changeset 494
- Timestamp:
- 2006-09-01T16:03:49+02:00 (18 years ago)
- Location:
- trunk/NEMO/TOP_SRC
- Files:
-
- 4 edited
-
SMS/trcini.pisces.h90 (modified) (5 diffs)
-
TRP/trcbbc.F90 (modified) (3 diffs)
-
TRP/trcdmp.F90 (modified) (9 diffs)
-
trcrst.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/TOP_SRC/SMS/trcini.pisces.h90
r341 r494 37 37 !!---------------------------------------------------------------------- 38 38 !! TOP 1.0 , LOCEAN-IPSL (2005) 39 !! $Header$ 40 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 41 !!---------------------------------------------------------------------- 39 !! $Header$ 40 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 41 !!---------------------------------------------------------------------- 42 !!Module used 43 USE iom 44 42 45 !! local declarations 43 46 !! ================== 44 47 INTEGER :: ji,jj,jk 45 INTEGER :: ichl,iband,mo 46 INTEGER , PARAMETER :: jpmois = 12, & 47 jpan = 1 48 49 REAL(wp) :: xtoto,expide,denitide,ztra,zmaskt 48 INTEGER :: ichl,iband,jm 49 INTEGER , PARAMETER :: jpmois = 12, jpan = 1 50 51 REAL(wp) :: ztoto,expide,denitide,ztra,zmaskt 50 52 REAL(wp) , DIMENSION (jpi,jpj) :: riverdoc,river,ndepo 51 CHARACTER (len=34) :: clname 52 53 INTEGER :: ipi,ipj,ipk,itime 54 INTEGER , DIMENSION (jpmois) :: istep 55 INTEGER , DIMENSION (jpan) :: istep0 56 REAL(wp) :: zsecond, zdate0 57 REAL(wp) , DIMENSION (jpi,jpj) :: zlon,zlat 58 REAL(wp), DIMENSION (jpk) :: zlev 53 59 54 INTEGER :: numriv,numdust,numbath,numdep 55 INTEGER :: numlight = 49 56 60 57 61 58 !! 1. initialization … … 72 69 IF(lwp) write(numout,*) ' Biology time step=',rfact2 73 70 71 74 72 !! INITIALISE DUST INPUT FROM ATMOSPHERE 75 73 !! ------------------------------------- 76 74 77 IF (bdustfer) THEN 78 clname='dust.orca.nc' 79 CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.false.,ipi,ipj,0 & 80 & ,zlon,zlat,zlev,itime,istep,zdate0,zsecond,numdust) 81 CALL flinget(numdust,'dust',jpidta,jpjdta,0,jpmois,1, & 82 & 12,mig(1),nlci,mjg(1),nlcj,dustmo(1:nlci,1:nlcj,:) ) 83 CALL flinclo(numdust) 84 85 ! Extra-halo initialization in MPP 86 IF( lk_mpp ) THEN 87 DO ji = nlci+1, jpi 88 dustmo(ji,:,:) = dustmo(1,:,:) 89 ENDDO 90 DO jj = nlcj+1, jpj 91 dustmo(:,jj,:)=dustmo(:,1,:) 92 ENDDO 93 ENDIF 75 IF ( bdustfer ) THEN 76 IF(lwp) WRITE(numout,*) ' Initialize dust input from atmosphere ' 77 CALL iom_open ( 'dust.orca.nc', numdust ) 78 DO jm = 1, jpmois 79 CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm ) 80 ENDDO 81 CALL iom_close( numdust ) 94 82 ELSE 95 dustmo(:,:,:) =0.83 dustmo(:,:,:) = 0. 96 84 ENDIF 85 86 do jm = 1, jpmois 87 write(numout,*) ' Mois : ',jm 88 write(numout,*) ( ( dustmo(ji,jj,jm), ji=1,jpi,20),jj=1,jpj,20) 89 enddo 90 97 91 98 92 !! INITIALISE THE NUTRIENT INPUT BY RIVERS 99 93 !! --------------------------------------- 100 94 101 IF (briver) THEN 102 clname='river.orca.nc' 103 CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.false.,ipi,ipj,0 & 104 & ,zlon,zlat,zlev,itime,istep0,zdate0,zsecond,numriv) 105 CALL flinget(numriv,'riverdic',jpidta,jpjdta,0,jpan,1, & 106 & 1,mig(1),nlci,mjg(1),nlcj,river(1:nlci,1:nlcj) ) 107 CALL flinget(numriv,'riverdoc',jpidta,jpjdta,0,jpan,1, & 108 & 1,mig(1),nlci,mjg(1),nlcj,riverdoc(1:nlci,1:nlcj) ) 109 CALL flinclo(numriv) 110 111 ! Extra-halo initialization in MPP 112 IF( lk_mpp ) THEN 113 DO ji = nlci+1, jpi 114 river(ji,:) = river(1,:) 115 riverdoc(ji,:) = riverdoc(1,:) 116 ENDDO 117 DO jj = nlcj+1, jpj 118 river(:,jj)=river(:,1) 119 riverdoc(:,jj) = riverdoc(:,1) 120 ENDDO 121 ENDIF 122 95 IF ( briver ) THEN 96 IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by rivers ' 97 CALL iom_open ( 'river.orca.nc', numriv ) 98 CALL iom_get ( numriv, jpdom_data, 'riverdic', river (:,:), jpan ) 99 CALL iom_get ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jpan ) 100 CALL iom_close( numriv ) 123 101 ELSE 124 river (:,:)=0.125 riverdoc(:,:) =0.102 river (:,:) = 0. 103 riverdoc(:,:) = 0. 126 104 endif 127 105 … … 129 107 !! --------------------------------------- 130 108 131 IF (bndepo) THEN 132 clname='ndeposition.orca.nc' 133 CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.false.,ipi,ipj,0 & 134 & ,zlon,zlat,zlev,itime,istep0,zdate0,zsecond,numdep) 135 CALL flinget(numdep,'ndep',jpidta,jpjdta,0,jpan,1, & 136 & 1,mig(1),nlci,mjg(1),nlcj,ndepo(1:nlci,1:nlcj) ) 137 CALL flinclo(numdep) 138 139 ! Extra-halo initialization in MPP 140 IF( lk_mpp ) THEN 141 DO ji = nlci+1, jpi 142 ndepo(ji,:) = ndepo(1,:) 143 ENDDO 144 DO jj = nlcj+1, jpj 145 ndepo(:,jj)=ndepo(:,1) 146 ENDDO 147 ENDIF 148 109 IF ( bndepo ) THEN 110 IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by dust ' 111 CALL iom_open ( 'ndeposition.orca.nc', numdep ) 112 CALL iom_get ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpan ) 113 CALL iom_close( numdep ) 149 114 ELSE 150 ndepo(:,:) =0.115 ndepo(:,:) = 0. 151 116 ENDIF 152 117 153 118 !! Computation of the coastal mask. 154 !! Computation of an island mask to enhance coastal supply 155 !! of iron 156 !! ------------------------------------------------------- 157 158 IF (bsedinput) THEN 159 clname='bathy.orca.nc' 160 CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.false.,ipi,ipj,ipk & 161 & ,zlon,zlat,zlev,itime,istep0,zdate0,zsecond,numbath) 162 CALL flinget(numbath,'bathy',jpidta,jpjdta,jpk,jpan,1, & 163 & 1,mig(1),nlci,mjg(1),nlcj,cmask(1:nlci,1:nlcj,1:jpk) ) 164 CALL flinclo(numbath) 165 166 do jk=1,5 167 do jj=2,jpj-1 168 do ji=2,jpi-1 169 if (tmask(ji,jj,jk).ne.0) then 170 zmaskt=tmask(ji+1,jj,jk)*tmask(ji-1,jj,jk)*tmask(ji,jj+1,jk) & 171 & *tmask(ji,jj-1,jk)*tmask(ji,jj,jk+1) 172 if (zmaskt.eq.0) then 173 cmask(ji,jj,jk)=0.1 174 endif 175 endif 176 end do 177 end do 178 end do 179 180 181 ! Extra-halo initialization in MPP 182 IF( lk_mpp ) THEN 183 DO ji = nlci+1, jpi 184 cmask(ji,:,:) = cmask(1,:,:) 185 ENDDO 186 DO jj = nlcj+1, jpj 187 cmask(:,jj,:)=cmask(:,1,:) 188 ENDDO 189 ENDIF 190 119 !! Computation of an island mask to enhance coastal supply of iron 120 !! --------------------------------------------------------------- 121 122 IF ( bsedinput ) THEN 123 IF(lwp) WRITE(numout,*) ' Computation of an island mask to enhance coastal supply of iron ' 124 CALL iom_open ( 'bathy.orca.nc', numbath ) 125 CALL iom_get ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpan ) 126 127 DO jk = 1, 5 128 DO jj = 2, jpjm1 129 DO ji = 2, jpim1 130 IF ( tmask(ji,jj,jk) /= 0. ) THEN 131 zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk) & 132 & * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) 133 IF ( zmaskt == 0. ) THEN 134 cmask(ji,jj,jk ) = 0.1 135 ENDIF 136 ENDIF 137 END DO 138 END DO 139 END DO 191 140 DO jk = 1, jpk 192 141 DO jj = 1, jpj 193 142 DO ji = 1, jpi 194 expide =min(8.,(fsdept(ji,jj,jk)/500.)**(-1.5))195 denitide =-0.9543+0.7662*log(expide)-0.235*log(expide)**2196 cmask(ji,jj,jk) =cmask(ji,jj,jk)*min(1.,exp(denitide)/0.5)143 expide = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) ) 144 denitide = -0.9543 + 0.7662 * LOG( expide ) - 0.235 * LOG( expide )**2 145 cmask(ji,jj,jk) = cmask(ji,jj,jk) * MIN( 1., EXP( denitide ) / 0.5 ) 197 146 END DO 198 147 END DO 199 148 END DO 200 149 150 CALL iom_close( numbath ) 201 151 ELSE 202 cmask(:,:,:) =0.152 cmask(:,:,:) = 0. 203 153 ENDIF 204 154 … … 209 159 !! ------------------------------------------------- 210 160 211 sumdepsi =0.212 DO mo=1,12213 DO jj =2,jpjm1214 DO ji =2,jpim1215 sumdepsi =sumdepsi+dustmo(ji,jj,mo)/(12.*rmoss)*8.8 &161 sumdepsi = 0. 162 DO jm = 1, jpmois 163 DO jj = 2, jpjm1 164 DO ji = 2, jpim1 165 sumdepsi = sumdepsi + dustmo(ji,jj,jm)/(12.*rmoss)*8.8 & 216 166 *0.075/28.1*e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,1) 217 167 END DO … … 472 422 !! A PRECOMPUTED ARRAY CORRESPONDING TO THE ATTENUATION COEFFICIENT 473 423 474 open(49,file='kRGB61.txt',form='formatted') 475 do ichl=1,61 476 READ(49,*) xtoto,(xkrgb(iband,ichl),iband = 1,3) 477 end do 478 close(49) 479 480 #if defined key_off_degrad 481 482 !! Read volume for degraded regions (DEGINIT) 483 !! ------------------------------------------ 484 485 # if defined key_vpp 486 CALL READ3S(902,facvol,jpi,jpj,jpk) 487 # else 488 READ (902) facvol 489 # endif 490 #endif 424 OPEN( numlight, file = 'kRGB61.txt', form = 'formatted') 425 DO ichl = 1,61 426 READ(numlight,*) ztoto,(xkrgb(iband,ichl),iband = 1,3) 427 END DO 428 CLOSE(numlight) 491 429 492 430 -
trunk/NEMO/TOP_SRC/TRP/trcbbc.F90
r352 r494 142 142 !!---------------------------------------------------------------------- 143 143 !! * Modules used 144 USE io ipsl144 USE iom 145 145 146 146 !! * local declarations … … 148 148 INTEGER :: ji, jj ! dummy loop indices 149 149 INTEGER :: inum = 11 ! temporary logical unit 150 INTEGER :: itime ! temporary integers151 REAL(wp) :: zdate0, zdt ! temporary scalars152 REAL(wp), DIMENSION(1) :: zdept ! temporary workspace153 REAL(wp), DIMENSION(jpidta,jpjdta) :: &154 zlamt, zphit, zdta ! temporary workspace155 150 156 151 NAMELIST/namtrcbbc/ngeo_trc_flux, ngeo_trc_flux_const … … 193 188 CASE ( 2 ) ! variable geothermal heat flux 194 189 ! read the geothermal fluxes in mW/m2 195 clname = 'passivetrc_geothermal_heating' 196 itime = 1 197 zlamt(:,:) = 0. 198 zphit(:,:) = 0. 199 IF(lwp) WRITE(numout,*) ' *** variable geothermal heat flux read in ', clname, ' file' 200 CALL restini( clname, jpidta, jpjdta, zlamt, zphit, 1, zdept , clname, & 201 itime, zdate0, zdt, inum , domain_id=nidom ) 202 CALL restget( inum, 'heatflow', jpidta, jpjdta, 1, 0, .FALSE., zdta ) 203 DO jj = 1, nlcj 204 DO ji = 1, nlci 205 qgh_trd(ji,jj) = zdta(mig(ji),mjg(jj)) 206 END DO 207 END DO 208 209 CALL restclo( inum ) 190 CALL iom_open ( 'geothermal_heating_trc.nc', inum ) 191 CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd ) 192 CALL iom_close (inum) 193 210 194 qgh_trd(:,:) = qgh_trd(:,:) * 1.e-3 ! conversion in W/m2 211 195 212 196 CASE DEFAULT 213 IF(lwp) WRITE(numout,cform_err) 214 IF(lwp) WRITE(numout,*) ' bad flag value for ngeo_trc_flux = ', ngeo_trc_flux 215 nstop = nstop + 1 197 WRITE(ctmp1,*) ' bad flag value for ngeo_flux = ', ngeo_flux 198 CALL ctl_stop( ctmp1 ) 216 199 217 200 END SELECT -
trunk/NEMO/TOP_SRC/TRP/trcdmp.F90
r433 r494 194 194 195 195 CASE DEFAULT 196 IF(lwp) WRITE(numout,cform_err) 197 IF(lwp) WRITE(numout,*) ' bad flag value for ndmptr = ', ndmptr 198 nstop = nstop + 1 196 WRITE(ctmp1,*) ' bad flag value for ndmp = ', ndmp 197 CALL ctl_stop(ctmp1) 199 198 200 199 END SELECT … … 213 212 214 213 CASE DEFAULT 215 IF(lwp) WRITE(numout,cform_err)216 IF(lwp) WRITE(numout,*) ' bad flag value for nmldmptr = ', nmldmptr217 nstop = nstop + 1 214 WRITE(ctmp1,*) ' bad flag value for nmldmp = ', nmldmp 215 CALL ctl_stop(ctmp1) 216 218 217 219 218 END SELECT … … 221 220 222 221 ! 3. Damping coefficients initialization 223 222 ! -------------------------------------- 224 223 225 224 IF( lzoom ) THEN … … 347 346 !!---------------------------------------------------------------------- 348 347 !! * Modules used 348 USE iom 349 349 USE ioipsl 350 350 351 351 !! * Local declarations 352 INTEGER :: ji, jj, jk, je, jn ! dummy loop indices 353 INTEGER, PARAMETER :: jpmois=1 354 INTEGER :: ipi, ipj, ipk ! temporary integers 355 INTEGER :: ii0, ii1, ij0, ij1 ! " " 352 INTEGER :: ji, jj, jk, jn ! dummy loop indices 353 INTEGER :: itime 354 INTEGER :: ii0, ii1, ij0, ij1 ! " " 356 355 INTEGER :: & 357 356 idmp, & ! logical unit for file restoring damping term 358 357 icot ! logical unit for file distance to the coast 359 INTEGER :: itime, istep(jpmois), ie 360 LOGICAL :: llbon 358 361 359 CHARACTER (len=32) :: clname, clname2, clname3 362 360 REAL(wp) :: & … … 365 363 zsdmp, zbdmp ! " " 366 364 REAL(wp), DIMENSION(jpk) :: & 367 zdept, zhfac365 gdept, zhfac 368 366 REAL(wp), DIMENSION(jpi,jpj) :: & 369 zmrs , zlamt, zphit367 zmrs 370 368 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 371 369 zdct … … 401 399 ! ... Distance to coast (zdct) 402 400 403 ! ... Test the existance of distance-to-coast file 404 itime = jpmois 405 ipi = jpiglo 406 ipj = jpjglo 407 ipk = jpk 408 clname = 'dist.coast.trc' 409 DO je = 1,32 410 IF( clname(je:je) == ' ' ) go to 140 411 END DO 412 140 CONTINUE 413 ie = je 414 clname2 = clname(1:ie-1)//".nc" 415 INQUIRE( FILE = clname2, EXIST = llbon ) 416 417 IF ( llbon ) THEN 418 419 ! ... Read file distance to coast if possible 420 CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj, .FALSE., & 421 ipi, ipj, ipk, zlamt, zphit, zdept, jpmois, & 422 istep, zdate0, rdt, icot ) 423 CALL flinget( icot, 'Tcoast', jpidta, jpjdta, jpk, & 424 jpmois, 1, 1, mig(1), nlci, mjg(1), nlcj, zdct(1:nlci,1:nlcj,1:jpk) ) 425 CALL flinclo( icot ) 426 IF(lwp)WRITE(numout,*) ' ** : File trc.dist.coast.nc read' 427 401 IF(lwp) WRITE(numout,*) 402 IF(lwp) WRITE(numout,*) ' dtacof : distance to coast file' 403 CALL iom_open ( 'dist.coast.trc.nc', icot ) 404 IF( icot > 0 ) THEN 405 CALL iom_get ( icot, jpdom_data, 'Tcoast', zdct ) 406 CALL iom_close (icot) 428 407 ELSE 429 430 408 ! ... Compute and save the distance-to-coast array (output in zdct) 431 CALL cofdis ( zdct ) 432 409 CALL cofdis( zdct ) 433 410 ENDIF 411 434 412 435 413 ! ... Compute arrays resto … … 598 576 ! ! ======================== 599 577 CASE ( 025 ) ! ORCA_R025 configuration 600 ! ! ======================== 601 IF(lwp) WRITE(numout,cform_err) 602 IF(lwp) WRITE(numout,*)' Not yet implemented in ORCA_R025' 603 nstop = nstop + 1 578 579 CALL ctl_stop( ' Not yet implemented in ORCA_R025' ) 604 580 605 581 END SELECT … … 620 596 ! No damping 621 597 ! ------------ 622 IF(lwp) WRITE(numout,cform_err) 623 IF(lwp) WRITE(numout,*) 'Choose a correct value of ndmptr or DO NOT defined key_trcdmp' 624 nstop = nstop + 1 598 CALL ctl_stop( 'Choose a correct value of ndmp or DO NOT defined key_tradmp' ) 599 625 600 ENDIF 626 601 … … 704 679 IF(lwp) WRITE(numout,*) '~~~~~~' 705 680 IF(lwp) WRITE(numout,*) 706 IF( lk_mpp ) THEN 707 IF(lwp) WRITE(numout,cform_err) 708 IF(lwp) WRITE(numout,*) ' Computation not yet implemented with key_mpp_...' 709 IF(lwp) WRITE(numout,*) ' Rerun the code on another computer or ' 710 IF(lwp) WRITE(numout,*) ' create the "dist.coast.nc" file using IDL' 711 nstop = nstop + 1 712 ENDIF 681 IF( lk_mpp ) & 682 & CALL ctl_stop(' Computation not yet implemented with key_mpp_...', & 683 & ' Rerun the code on another computer or ', & 684 & ' create the "dist.coast.nc" file using IDL' ) 685 713 686 714 687 pdct(:,:,:) = 0.e0 -
trunk/NEMO/TOP_SRC/trcrst.F90
r433 r494 71 71 !!------------------------------------------------------------------------ 72 72 !! * Modules used 73 USE io ipsl73 USE iom 74 74 75 75 76 76 !! local declarations 77 77 !! ================== 78 LOGICAL :: llog !!! 79 CHARACTER (len=32) :: clname1,clname2 80 CHARACTER (len=32) :: clname = 'restart.trc' 81 CHARACTER (len=12) :: clvnames(80) 82 83 INTEGER :: ino1,jn,iarak0,iarak1, & 84 ji, jj, jk, & 85 itime, ibvar 86 REAL(wp) :: caralk,bicarb,zdt, & 87 zdate0 88 REAL(wp) :: zdept(jpk), zlamt(jpi,jpj), zphit(jpi,jpj) 89 90 REAL(wp), DIMENSION(3) :: zinfo 78 79 INTEGER :: & 80 ji, jj, jk, jn 81 INTEGER :: & 82 inum, iarak0 ! temporary logical unit 83 REAL(wp), DIMENSION(1, 1, 3) :: zinfo 84 85 CHARACTER (len=32) :: clname1,clname2,clname 86 REAL(wp) :: caralk,bicarb 91 87 92 88 #if defined key_trc_pisces 93 # if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 )94 REAL(wp) :: zareatot, z po4tot95 # endif89 # if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 90 REAL(wp) :: zareatot, ztrasum 91 # endif 96 92 #endif 97 93 … … 106 102 iarak0 = 1 107 103 ELSE 108 iarak0 =0104 iarak0 = 0 109 105 ENDIF 110 106 … … 117 113 IF(lwp) WRITE(numout,*) ' with the time nit000 : ',nit000 118 114 IF(lwp) THEN 119 IF( iarak0.eq.1) then115 IF( iarak0 == 1 ) THEN 120 116 WRITE(numout,*) ' and before fields for Arakawa sheme ' 121 117 ENDIF … … 142 138 143 139 144 !! 1. READ nutrst 145 !! -------------- 146 !! ... first information 147 !! --------------------- 148 itime=0 149 llog=.false. !!! 150 zlamt(:,:) = 0.e0 151 zphit(:,:) = 0.e0 152 zdept(:) = 0.e0 153 CALL restini(clname,jpi,jpj,zlamt,zphit,jpk,zdept,clname & 154 & ,itime,zdate0,zdt,nutrst,domain_id=nidom) 155 156 CALL ioget_vname(nutrst, ibvar, clvnames) 157 CALL restget(nutrst,'info',1,1,3,0,llog,zinfo) 158 ino1 = nint(zinfo(1)) 159 iarak1 = nint(zinfo(3)) 160 161 IF(lwp) WRITE(numout,*) ' ' 162 IF(lwp) WRITE(numout,*) ' READ nutrst with ' 163 IF(lwp) WRITE(numout,*) ' number job is : ',ino1 164 IF(lwp) WRITE(numout,*) ' with the time it : ',nint(zinfo(2)) 165 IF(lwp) THEN 166 IF(iarak1.eq.1) then 167 WRITE(numout,*) ' and before fields for Arakawa sheme ' 168 ENDIF 169 ENDIF 170 IF(lwp) WRITE(numout,*) ' number of variables : ', ibvar 171 IF(lwp) WRITE(numout,*) ' NetCDF variables : ' 172 IF(lwp) WRITE(numout,*) ' ',clvnames (:ibvar) 173 IF(lwp) WRITE(numout,*) ' ' 174 175 !! 1.2 control of date 140 141 CALL iom_open ( 'restart.trc', inum ) 142 143 CALL iom_get ( inum, jpdom_unknown, 'info', zinfo ) 144 145 IF(lwp) WRITE(numout,*) 146 IF(lwp) WRITE(numout,*) ' Info on the restart file read : ' 147 IF(lwp) WRITE(numout,*) ' job number : ', NINT( zinfo(1, 1, 1) ) 148 IF(lwp) WRITE(numout,*) ' time-step : ', NINT( zinfo(1, 1, 2) ) 149 IF(lwp) WRITE(numout,*) ' arakawa option : ', NINT( zinfo(1, 1, 3) ) 150 IF(lwp) WRITE(numout,*) 151 152 153 !! control of date 176 154 !! ------------------- 177 155 178 IF( nit000- NINT( zinfo(2) ) /= 1 .AND. nrsttr /= 0 ) THEN 179 IF(lwp) THEN 180 WRITE(numout,*) ' ===>>>> : problem with nit000 for the', & 181 ' passive tracer restart' 182 WRITE(numout,*) ' ======= ', & 183 ' ======================' 184 WRITE(numout,*) ' we stop. verify the FILE' 185 WRITE(numout,*) ' or rerun with the value 0 for the' 186 WRITE(numout,*) ' control of time PARAMETER nrstdt' 187 WRITE(numout,*) ' ' 188 ENDIF 189 STOP 'trc_rst' !! 190 ENDIF 191 192 !! 1.3 Control of the sheme 156 IF( nittrc000 - NINT( zinfo( 1, 1, 2 ) ) /= 1 .AND. nrsttr /= 0 ) & 157 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 158 & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 159 160 !! Control of the scheme 193 161 !! ------------------------ 194 162 195 IF(iarak0.ne.iarak1) THEN 196 IF(lwp) THEN 197 WRITE(numout,*) ' ===>>>> : problem with the', & 198 ' passive tracer restart file' 199 WRITE(numout,*) ' ======= ', & 200 ' ===========================' 201 WRITE(numout,*) ' we stop. verify the FILE' 202 WRITE(numout,*) ' before field required IF 1=',iarak0 203 WRITE(numout,*) ' before field present in file IF 1=', & 204 iarak1 205 WRITE(numout,*) ' ' 206 ENDIF 207 STOP 'trc_rst' !!!!! AVERIFIER AU NIV F90' 208 ENDIF 163 IF( iarak0 /= NINT( zinfo(1, 1, 3 ) ) ) & 164 & CALL ctl_stop( ' ===>>>> : problem with advection scheme', & 165 & ' it must be the same type for both restart and previous run', & 166 & ' centered or euler ' ) 209 167 210 168 … … 212 170 !! --------------------------------------------------------------- 213 171 214 DO jn =1,jptra215 clname ='TRN'//ctrcnm(jn)216 CALL restget(nutrst,clname,jpi,jpj,jpk,0,llog,trn(:,:,:,jn))172 DO jn = 1, jptra 173 clname = 'TRN'//ctrcnm(jn) 174 CALL iom_get( inum, jpdom_local, clname, trn(:,:,:,jn) ) 217 175 END DO 218 176 219 DO jn =1,jptra220 clname ='TRB'//ctrcnm(jn)221 CALL restget(nutrst,clname,jpi,jpj,jpk,0,llog,trb(:,:,:,jn))177 DO jn = 1, jptra 178 clname = 'TRB'//ctrcnm(jn) 179 CALL iom_get( inum, jpdom_local, clname, trb(:,:,:,jn) ) 222 180 END DO 223 181 224 225 182 #if defined key_trc_lobster1 226 clname='SEDB'//ctrcnm(jpdet) 227 clname1='SEDN'//ctrcnm(jpdet) 228 CALL restget(nutrst,clname,jpi,jpj,1,0,llog,sedpocb(:,:)) 229 CALL restget(nutrst,clname1,jpi,jpj,1,0,llog,sedpocn(:,:)) 183 clname = 'SEDB'//ctrcnm(jpdet) 184 clname1 = 'SEDN'//ctrcnm(jpdet) 185 CALL iom_get( inum, jpdom_local, clname , sedpocb(:,:) ) 186 CALL iom_get( inum, jpdom_local, clname1, sedpocn(:,:) ) 187 230 188 #elif defined key_trc_pisces 231 clname='Silicalim' 232 CALL restget(nutrst,clname,jpi,jpj,1,0,llog,xksi) 233 xksimax=xksi 234 235 clname='SED'//ctrcnm(jppoc) 236 clname1='SED'//ctrcnm(jpcal) 237 clname2='SED'//ctrcnm(jpsil) 238 CALL restget(nutrst,clname1,jpi,jpj,1,0,llog,sedcal(:,:)) 239 CALL restget(nutrst,clname2,jpi,jpj,1,0,llog,sedsil(:,:)) 240 CALL restget(nutrst,clname,jpi,jpj,1,0,llog,sedpoc(:,:)) 189 clname = 'Silicalim' 190 CALL iom_get( inum, jpdom_local, clname, xksi(:,:) ) 191 xksimax = xksi 192 193 clname = 'SED'//ctrcnm(jppoc) 194 clname1 = 'SED'//ctrcnm(jpcal) 195 clname2 = 'SED'//ctrcnm(jpsil) 196 197 CALL iom_get( inum, jpdom_local, clname , sedpoc(:,:) ) 198 CALL iom_get( inum, jpdom_local, clname1, sedcal(:,:) ) 199 CALL iom_get( inum, jpdom_local, clname2, sedsil(:,:) ) 241 200 242 201 #elif defined key_cfc 243 clname='qint' 244 CALL restget(nutrst,clname,jpi,jpj,jptra,0,llog,qint(:,:,:)) 245 clname1='qtr' 246 CALL restget(nutrst,clname1,jpi,jpj,jptra,0,llog,qtr(:,:,:)) 202 clname = 'qint' 203 clname1 = 'qtr' 204 205 CALL iom_get( inum, jpdom_local, clname , qint(:,:,:) ) 206 CALL iom_get( inum, jpdom_local, clname1, qtr (:,:,:) ) 247 207 #endif 248 208 … … 255 215 DO jj = 1, jpj 256 216 DO ji = 1, jpi 257 zareatot = zareatot + tmask(ji,jj,jk) * tmask_i(ji,jj) * & 258 & e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 217 zareatot = zareatot + tmask(ji,jj,jk) * tmask_i(ji,jj) & 218 #if defined key_off_degrad 219 & * facvol(ji,jj,jk) & 220 #endif 221 222 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 259 223 END DO 260 224 END DO … … 265 229 END IF 266 230 267 z po4tot= 0.231 ztrasum = 0. 268 232 DO jk = 1, jpk 269 233 DO jj = 1, jpj 270 234 DO ji = 1, jpi 271 zpo4tot = zpo4tot + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj) * & 272 & e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 235 ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 236 #if defined key_off_degrad 237 & * facvol(ji,jj,jk) & 238 #endif 239 240 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 273 241 END DO 274 242 END DO … … 276 244 277 245 IF( lk_mpp ) THEN 278 CALL mpp_sum( z po4tot) ! sum over the global domain246 CALL mpp_sum( ztrasum ) ! sum over the global domain 279 247 END IF 280 248 281 WRITE(0,*) 'TALK moyen ', z po4tot/zareatot*1E6282 z po4tot = zpo4tot/zareatot*1E6283 trn(:,:,:,jptal) = trn(:,:,:,jptal)*2391./z po4tot284 285 z po4tot= 0.249 WRITE(0,*) 'TALK moyen ', ztrasum/zareatot*1E6 250 ztrasum = ztrasum/zareatot*1E6 251 trn(:,:,:,jptal) = trn(:,:,:,jptal)*2391./ztrasum 252 253 ztrasum = 0. 286 254 DO jk = 1, jpk 287 255 DO jj = 1, jpj 288 256 DO ji = 1, jpi 289 zpo4tot = zpo4tot + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj) * & 290 & e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 257 ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 258 #if defined key_off_degrad 259 & * facvol(ji,jj,jk) & 260 #endif 261 262 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 291 263 END DO 292 264 END DO … … 294 266 295 267 IF( lk_mpp ) THEN 296 CALL mpp_sum( z po4tot) ! sum over the global domain268 CALL mpp_sum( ztrasum ) ! sum over the global domain 297 269 END IF 298 270 299 271 300 WRITE(0,*) 'PO4 moyen ', z po4tot/zareatot*1E6/122.301 z po4tot = zpo4tot/zareatot*1E6/122.302 trn(:,:,:,jppo4) = trn(:,:,:,jppo4)*2.165/z po4tot303 304 z po4tot= 0.272 WRITE(0,*) 'PO4 moyen ', ztrasum/zareatot*1E6/122. 273 ztrasum = ztrasum/zareatot*1E6/122. 274 trn(:,:,:,jppo4) = trn(:,:,:,jppo4)*2.165/ztrasum 275 276 ztrasum = 0. 305 277 DO jk = 1, jpk 306 278 DO jj = 1, jpj 307 279 DO ji = 1, jpi 308 zpo4tot = zpo4tot + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj) * & 309 & e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 280 ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 281 #if defined key_off_degrad 282 & * facvol(ji,jj,jk) & 283 #endif 284 285 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 310 286 END DO 311 287 END DO … … 313 289 314 290 IF( lk_mpp ) THEN 315 CALL mpp_sum( z po4tot) ! sum over the global domain291 CALL mpp_sum( ztrasum ) ! sum over the global domain 316 292 END IF 317 293 318 294 319 WRITE(0,*) 'NO3 moyen ', z po4tot/zareatot*1E6/7.6320 z po4tot = zpo4tot/zareatot*1E6/7.6321 trn(:,:,:,jpno3) = trn(:,:,:,jpno3)*30.9/z po4tot322 323 z po4tot= 0.295 WRITE(0,*) 'NO3 moyen ', ztrasum/zareatot*1E6/7.6 296 ztrasum = ztrasum/zareatot*1E6/7.6 297 trn(:,:,:,jpno3) = trn(:,:,:,jpno3)*30.9/ztrasum 298 299 ztrasum = 0. 324 300 DO jk = 1, jpk 325 301 DO jj = 1, jpj 326 302 DO ji = 1, jpi 327 zpo4tot = zpo4tot + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj) * & 328 & e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 303 ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 304 #if defined key_off_degrad 305 & * facvol(ji,jj,jk) & 306 #endif 307 308 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 329 309 END DO 330 310 END DO … … 332 312 333 313 IF( lk_mpp ) THEN 334 CALL mpp_sum( z po4tot) ! sum over the global domain314 CALL mpp_sum( ztrasum ) ! sum over the global domain 335 315 END IF 336 316 337 WRITE(0,*) 'SiO3 moyen ', z po4tot/zareatot*1E6338 z po4tot = zpo4tot/zareatot*1E6339 trn(:,:,:,jpsil) = MIN( 400E-6,trn(:,:,:,jpsil)*91.51/z po4tot)317 WRITE(0,*) 'SiO3 moyen ', ztrasum/zareatot*1E6 318 ztrasum = ztrasum/zareatot*1E6 319 trn(:,:,:,jpsil) = MIN( 400E-6,trn(:,:,:,jpsil)*91.51/ztrasum) 340 320 341 321 #endif … … 357 337 ENDDO 358 338 #endif 339 trb(:,:,:,:) = trn(:,:,:,:) 340 341 CALL iom_close( inum ) 342 359 343 360 344 END SUBROUTINE trc_rst … … 432 416 !! --------------------------- 433 417 434 IF( kt == nit 000 ) THEN418 IF( kt == nittrc000 ) THEN 435 419 IF(lwp) WRITE(numout,*) 436 420 IF(lwp) WRITE(numout,*) 'trc_wri : write passive tracers restart.output NetCDF file' … … 518 502 itime=0 519 503 CALL ymds2ju(nyear,nmonth,nday,0.0,zdate0) 520 CALL restini('NONE',jpi,jpj,glamt,gphit,jpk,gdept ,clname &504 CALL restini('NONE',jpi,jpj,glamt,gphit,jpk,gdept_0,clname & 521 505 & ,itime,zdate0,rdt*nstock,nutwrs,domain_id=nidom) 522 506
Note: See TracChangeset
for help on using the changeset viewer.
