Changeset 382
- Timestamp:
- 2006-02-06T16:15:11+01:00 (18 years ago)
- Location:
- trunk/NEMO/OFF_SRC
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OFF_SRC/DOM/domrea.F90
r354 r382 91 91 inum4 ! 'mesh_zgr.nc' file 92 92 INTEGER :: itime ! output from restini ??? 93 REAL(wp) :: zdate0, zd epwp, ze3tp, ze3wp93 REAL(wp) :: zdate0, zdt 94 94 REAL(wp), DIMENSION(jpidta,jpjdta) :: & 95 95 zta ! dummy array for bathymetry … … 112 112 113 113 llog = .FALSE. 114 114 115 CALL ymds2ju( 0, 1, 1, 0.e0, zdate0 ) ! calendar initialization 115 116 … … 128 129 CALL restini( clnam0, jpidta , jpjdta , glamt, gphit, & ! create 'mesh_mask.nc' file 129 130 & jpk , gdept , trim(clnam0) , & ! in unit inum0 130 & itime , zdate0, rdt , inum0, domain_id=nidom )131 & itime , zdate0, zdt , inum0, domain_id=nidom ) 131 132 inum2 = inum0 ! put all the informations 132 133 inum3 = inum0 ! in unit inum0 … … 141 142 CALL restini( clnam1, jpidta , jpjdta , glamt, gphit, & ! create 'mesh.nc' file 142 143 & jpk , gdept , trim(clnam1) , & ! in unit inum1 143 & itime , zdate0, rdt , inum1, domain_id=nidom )144 & itime , zdate0, zdt , inum1, domain_id=nidom ) 144 145 CALL restini( clnam2, jpidta , jpjdta , glamt, gphit, & ! create 'mask.nc' file 145 146 & jpk , gdept , trim(clnam2) , & ! in unit inum2 146 & itime , zdate0, rdt , inum2, domain_id=nidom )147 & itime , zdate0, zdt , inum2, domain_id=nidom ) 147 148 inum3 = inum1 ! put mesh informations 148 149 inum4 = inum1 ! in unit inum1 … … 157 158 CALL restini( clnam3, jpidta , jpjdta , glamt, gphit, & ! create 'mesh_hgr.nc' file 158 159 & jpk , gdept , trim(clnam3) , & ! in unit inum3 159 & itime , zdate0, rdt , inum3, domain_id=nidom )160 & itime , zdate0, zdt , inum3, domain_id=nidom ) 160 161 CALL restini( clnam4, jpidta , jpjdta , glamt, gphit, & ! create 'mesh_zgr.nc' file 161 162 & jpk , gdept , trim(clnam4) , & ! in unit inum4 162 & itime , zdate0, rdt , inum4, domain_id=nidom )163 & itime , zdate0, zdt , inum4, domain_id=nidom ) 163 164 CALL restini( clnam2, jpidta , jpjdta , glamt, gphit, & ! create 'mask.nc' file 164 165 & jpk , gdept , trim(clnam2) , & ! in unit inum2 165 & itime , zdate0, rdt , inum2, domain_id=nidom )166 & itime , zdate0, zdt , inum2, domain_id=nidom ) 166 167 167 168 END SELECT … … 200 201 END DO 201 202 END DO 203 204 #if defined key_off_degrad 205 CALL restget( inum2, 'facvolt', jpidta, jpjdta, jpk, 0, llog, zt3a ) 206 DO jk = 1, jpk 207 DO jj = 1, nlcj 208 DO ji = 1, nlci 209 facvol(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) 210 END DO 211 END DO 212 END DO 213 #endif 202 214 203 215 ! ! horizontal mesh (inum3) … … 391 403 CALL restget( inum4, 'e3w' , 1, 1, jpk, 0, llog, e3w ) 392 404 393 do jk=1,jpk 394 gdept_ps(:,:,jk) = gdept(jk) 395 gdepw_ps(:,:,jk) = gdepw(jk) 396 end do 397 398 DO jj = 1, jpj 399 DO ji = 1, jpi 400 ik = mbathy(ji,jj) 401 ! ocean point only 402 IF( ik > 0 ) THEN 403 ! max ocean level case 404 IF( ik == jpkm1 ) THEN 405 zdepwp = mbathy(ji,jj) 406 ze3tp = mbathy(ji,jj) - gdepw(ik) 407 ze3wp = 0.5 * e3w(ik) * ( 1. + ( ze3tp/e3t(ik) ) ) 408 gdepw_ps(ji,jj,ik+1) = zdepwp 409 gdept_ps(ji,jj,ik ) = gdept(ik-1) + ze3wp 410 gdept_ps(ji,jj,ik+1) = gdept_ps(ji,jj,ik) + ze3tp 411 ! standard case 412 ELSE 413 !!alex 414 IF( mbathy(ji,jj) <= gdepw(ik+1) ) THEN 415 gdepw_ps(ji,jj,ik+1) = mbathy(ji,jj) 416 ELSE 417 gdepw_ps(ji,jj,ik+1) = gdepw(ik+1) 418 ENDIF 419 !!Alex 420 !!Alex gdepw_ps(ji,jj,ik+1) = mbathy(ji,jj) 421 gdept_ps(ji,jj,ik ) = gdepw(ik) + ( gdepw_ps(ji,jj,ik+1) - gdepw(ik)) & 422 * ((gdept ( ik ) - gdepw(ik)) & 423 / ( gdepw ( ik+1) - gdepw(ik))) 424 gdept_ps(ji,jj,ik+1) = gdept_ps(ji,jj,ik) + e3t_ps (ji,jj,ik) 425 ENDIF 426 ENDIF 427 END DO 428 END DO 429 405 DO jk=1,jpk 406 gdept_ps(:,:,jk) = gdept(jk) 407 gdepw_ps(:,:,jk) = gdepw(jk) 408 END DO 409 410 DO jj = 1, jpj 411 DO ji = 1, jpi 412 ik = mbathy(ji,jj) - 1 413 ! ocean point only 414 IF( ik > 0 ) THEN 415 ! max ocean level case 416 gdepw_ps(ji,jj,ik+1) = hdepw(ji,jj) 417 gdept_ps(ji,jj,ik ) = hdept(ji,jj) 418 gdept_ps(ji,jj,ik+1) = gdept_ps(ji,jj,ik) + e3t_ps(ji,jj,ik) 419 ENDIF 420 END DO 421 END DO 422 430 423 431 424 # else -
trunk/NEMO/OFF_SRC/dtadyn.F90
r343 r382 20 20 USE zdfmxl 21 21 USE trabbl ! tracers: bottom boundary layer 22 USE ldftra_oce 22 23 USE ocfzpt 23 24 USE zdfddm ! vertical physics: double diffusion … … 84 85 bblydta ! frequency of bbl in the y direction at 2 consecutive times 85 86 #endif 87 86 88 87 89 !! * Substitutions … … 261 263 WRITE(numout,*)' temperature ' 262 264 WRITE(numout,*) 263 CALL prihre(tn(1,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 265 CALL prihre(tn(1,1,1),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 266 WRITE(numout,*) 264 267 WRITE(numout,*) ' level = ',jpk/2 265 CALL prihre(tn(1,1,jpk/2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 268 CALL prihre(tn(1,1,jpk/2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 269 WRITE(numout,*) 266 270 WRITE(numout,*) ' level = ',jpkm1 267 CALL prihre(tn(1,1,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 271 CALL prihre(tn(1,1,jpkm1),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 272 WRITE(numout,*) 273 WRITE(numout,*)' salinity ' 274 WRITE(numout,*) 275 CALL prihre(sn(1,1,1),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 276 WRITE(numout,*) 277 WRITE(numout,*) ' level = ',jpk/2 278 CALL prihre(sn(1,1,jpk/2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 279 WRITE(numout,*) 280 WRITE(numout,*) ' level = ',jpkm1 281 CALL prihre(sn(1,1,jpkm1),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 282 WRITE(numout,*) 283 WRITE(numout,*)' Kz ' 284 WRITE(numout,*) 285 CALL prihre(avtdta(1,1,1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 286 WRITE(numout,*) 287 WRITE(numout,*) ' level = ',jpk/2 288 CALL prihre(avtdta(1,1,jpk/2,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 289 WRITE(numout,*) 290 WRITE(numout,*) ' level = ',jpkm1 291 CALL prihre(avtdta(1,1,jpkm1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 292 WRITE(numout,*) 293 WRITE(numout,*)' zonal wind ' 294 WRITE(numout,*) 295 CALL prihre(udta(1,1,1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 296 WRITE(numout,*) 297 WRITE(numout,*) ' level = ',jpk/2 298 CALL prihre(udta(1,1,jpk/2,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 299 WRITE(numout,*) 300 WRITE(numout,*) ' level = ',jpkm1 301 CALL prihre(udta(1,1,jpkm1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 302 WRITE(numout,*) 303 WRITE(numout,*)' meridional wind ' 304 WRITE(numout,*) 305 CALL prihre(vdta(1,1,1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 306 WRITE(numout,*) 307 WRITE(numout,*) ' level = ',jpk/2 308 CALL prihre(vdta(1,1,jpk/2,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 309 WRITE(numout,*) 310 WRITE(numout,*) ' level = ',jpkm1 311 CALL prihre(vdta(1,1,jpkm1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 312 WRITE(numout,*) 313 WRITE(numout,*)' vertical volocity ' 314 WRITE(numout,*) 315 CALL prihre(wdta(1,1,1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 316 WRITE(numout,*) 317 WRITE(numout,*) ' level = ',jpk/2 318 CALL prihre(wdta(1,1,jpk/2,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 319 WRITE(numout,*) 320 WRITE(numout,*) ' level = ',jpkm1 321 CALL prihre(wdta(1,1,jpkm1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 268 322 WRITE(numout,*) 269 323 WRITE(numout,*)' Wind ' 270 WRITE(numout,*) 271 CALL prihre(flxdta(1,1,jpwind,2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 324 CALL prihre(flxdta(1,1,jpwind,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 325 #if defined key_trcbbl_dif || defined key_trcbbl_adv 326 WRITE(numout,*) 327 WRITE(numout,*)' BBL zonal' 328 CALL prihre(bblxdta(1,1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 329 WRITE(numout,*) 330 WRITE(numout,*)' BBL meridional' 331 CALL prihre(bblydta(1,1,2),jpi,jpj,1,jpi,10,1,jpj,10,1.,numout) 332 333 #endif 334 272 335 ENDIF 273 336 … … 305 368 bblydta(:,:,1)=bblydta(:,:,2) 306 369 #endif 370 371 307 372 ! 308 373 ! indicates a swap … … 379 444 bblydta(:,:,1)=bblydta(:,:,2) 380 445 #endif 446 447 381 448 ! 382 449 ! indicates a swap … … 458 525 bbly(:,:)=bblydta(:,:,2) 459 526 #endif 527 460 528 ! 461 529 ! keep needed fluxes … … 501 569 bbly(:,:)= zweighm1 * bblydta(:,:,1) + zweigh * bblydta(:,:,2) 502 570 #endif 571 503 572 ! 504 573 ! keep needed fluxes … … 552 621 INTEGER , DIMENSION(ndtatot) :: istep 553 622 554 REAL(wp) :: zdate0 623 REAL(wp) :: zdate0, zdt 555 624 556 625 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 557 zu, zv, zw, zt, zs, zavt , zaeiu, zaeiv, zaeiw! 3-D dynamical fields626 zu, zv, zw, zt, zs, zavt ! 3-D dynamical fields 558 627 559 628 REAL(wp), DIMENSION(jpi,jpj) :: & … … 563 632 zbblx, zbbly 564 633 #endif 634 565 635 REAL(wp), DIMENSION(jpk) :: zlev 566 636 … … 576 646 ! le dernier champ temporel 577 647 648 578 649 jkenr = kenr 579 650 … … 594 665 595 666 CALL flinopen(clname_t,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 596 & ipk,zlon,zlat,zlev,itime,istep,zdate0, rdt,numfl_t)667 & ipk,zlon,zlat,zlev,itime,istep,zdate0,zdt,numfl_t) 597 668 598 669 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN … … 608 679 609 680 CALL flinopen(clname_u,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 610 & ipk,zlon,zlat,zlev,itime,istep,zdate0, rdt,numfl_u)681 & ipk,zlon,zlat,zlev,itime,istep,zdate0,zdt,numfl_u) 611 682 612 683 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN … … 622 693 623 694 CALL flinopen(clname_v,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 624 & ipk,zlon,zlat,zlev,itime,istep,zdate0, rdt,numfl_v)695 & ipk,zlon,zlat,zlev,itime,istep,zdate0,zdt,numfl_v) 625 696 626 697 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN … … 636 707 637 708 CALL flinopen(clname_w,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 638 & ipk,zlon,zlat,zlev,itime,istep,zdate0, rdt,numfl_w)709 & ipk,zlon,zlat,zlev,itime,istep,zdate0,zdt,numfl_w) 639 710 640 711 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN … … 650 721 651 722 CALL flinopen(clname_s,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 652 & ipk,zlon,zlat,zlev,itime,istep,zdate0, rdt,numfl_s)723 & ipk,zlon,zlat,zlev,itime,istep,zdate0,zdt,numfl_s) 653 724 654 725 IF( ipi /= jpidta .OR. ipj /= jpjdta ) THEN … … 672 743 #endif 673 744 674 # if defined key_traldf_eiv675 CALL flinget(numfl_u,'vozoeivu',jpidta,jpjdta,jpk,idtatot,jkenr, &676 & jkenr,mig(1),nlci,mjg(1),nlcj,zaeiu(1:nlci,1:nlcj,1:jpk))677 #endif678 745 679 746 CALL flinget(numfl_v,'vomecrty',jpidta,jpjdta,jpk,idtatot,jkenr, & … … 685 752 #endif 686 753 687 # if defined key_traldf_eiv688 CALL flinget(numfl_v,'vomeeivv',jpidta,jpjdta,jpk,idtatot,jkenr, &689 & jkenr,mig(1),nlci,mjg(1),nlcj,zaeiv(1:nlci,1:nlcj,1:jpk))690 #endif691 692 754 CALL flinget(numfl_w,'vovecrtz',jpidta,jpjdta,jpk,idtatot,jkenr, & 693 755 & jkenr,mig(1),nlci,mjg(1),nlcj,zw(1:nlci,1:nlcj,1:jpk)) 694 695 # if defined key_traldf_eiv696 CALL flinget(numfl_w,'voveeivw',jpidta,jpjdta,jpk,idtatot,jkenr, &697 & jkenr,mig(1),nlci,mjg(1),nlcj,zaeiw(1:nlci,1:nlcj,1:jpk))698 #endif699 756 700 757 … … 715 772 CALL flinget(numfl_t,'somixhgt',jpidta,jpjdta,1,idtatot,jkenr, & 716 773 & jkenr,mig(1),nlci,mjg(1),nlcj,zmld(1:nlci,1:nlcj)) 717 718 774 719 775 CALL flinget(numfl_t,'sowaflup',jpidta,jpjdta,1,idtatot,jkenr, & … … 748 804 zbbly(ji,:)=zbbly(1,:) 749 805 #endif 750 #if defined key_traldf_eiv 751 zaeiu(ji,:,:)=zaeiu(1,:,:) 752 zaeiv(ji,:,:)=zaeiv(1,:,:) 753 zaeiw(ji,:,:)=zaeiw(1,:,:) 754 #endif 806 755 807 ENDDO 756 808 DO jj = nlcj+1, jpj … … 770 822 zbbly(:,jj)=zbbly(:,1) 771 823 #endif 772 #if defined key_traldf_eiv 773 zaeiu(:,jj,:)=zaeiu(:,1,:) 774 zaeiv(:,jj,:)=zaeiv(:,1,:) 775 zaeiw(:,jj,:)=zaeiw(:,1,:) 776 #endif 824 777 825 ENDDO 778 826 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.