Changeset 14072 for NEMO/trunk/src/ICE/icedyn_adv_pra.F90
- Timestamp:
- 2020-12-04T08:48:38+01:00 (3 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/ICE/icedyn_adv_pra.F90 (modified) (47 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/icedyn_adv_pra.F90
r14005 r14072 1 MODULE icedyn_adv_pra 1 MODULE icedyn_adv_pra 2 2 !!====================================================================== 3 3 !! *** MODULE icedyn_adv_pra *** … … 35 35 36 36 ! Moments for advection 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxice, syice, sxxice, syyice, sxyice ! ice thickness 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxice, syice, sxxice, syyice, sxyice ! ice thickness 38 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxsn , sysn , sxxsn , syysn , sxysn ! snow thickness 39 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxa , sya , sxxa , syya , sxya ! ice concentration … … 59 59 !!---------------------------------------------------------------------- 60 60 !! ** routine ice_dyn_adv_pra ** 61 !! 61 !! 62 62 !! ** purpose : Computes and adds the advection trend to sea-ice 63 63 !! … … 101 101 REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl) :: z0ei 102 102 !! diagnostics 103 REAL(wp), DIMENSION(jpi,jpj) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat 103 REAL(wp), DIMENSION(jpi,jpj) :: zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat 104 104 !!---------------------------------------------------------------------- 105 105 ! … … 127 127 ELSEWHERE ; ze_s(:,:,jk,:) = 0._wp 128 128 END WHERE 129 END DO 129 END DO 130 130 CALL icemax4D( ze_i , zei_max ) 131 131 CALL icemax4D( ze_s , zes_max ) … … 139 139 zcflnow(1) = MAXVAL( ABS( pu_ice(:,:) ) * rDt_ice * r1_e1u(:,:) ) 140 140 zcflnow(1) = MAX( zcflnow(1), MAXVAL( ABS( pv_ice(:,:) ) * rDt_ice * r1_e2v(:,:) ) ) 141 141 142 142 ! non-blocking global communication send zcflnow and receive zcflprv 143 143 CALL mpp_delay_max( 'icedyn_adv_pra', 'cflice', zcflnow(:), zcflprv(:), kt == nitend - nn_fsbc + 1 ) … … 148 148 zdt = rDt_ice / REAL(icycle) 149 149 z1_dt = 1._wp / zdt 150 150 151 151 ! --- transport --- ! 152 152 zudy(:,:) = pu_ice(:,:) * e2u(:,:) … … 164 164 ! record at_i before advection (for open water) 165 165 zati1(:,:) = SUM( pa_i(:,:,:), dim=3 ) 166 167 ! --- transported fields --- ! 166 167 ! --- transported fields --- ! 168 168 DO jl = 1, jpl 169 169 zarea(:,:,jl) = e1e2t(:,:) … … 209 209 END DO 210 210 DO jk = 1, nlay_i !--- ice heat content 211 CALL adv_x( zdt, zudy, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 211 CALL adv_x( zdt, zudy, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 212 212 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 213 CALL adv_y( zdt, zvdx, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 213 CALL adv_y( zdt, zvdx, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 214 214 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 215 215 END DO … … 217 217 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 218 218 CALL adv_x( zdt , zudy , 1._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) !--- melt pond fraction 219 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 219 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0ap , sxap , sxxap , syap , syyap , sxyap ) 220 220 CALL adv_x( zdt , zudy , 1._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) !--- melt pond volume 221 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 221 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vp , sxvp , sxxvp , syvp , syyvp , sxyvp ) 222 222 IF ( ln_pnd_lids ) THEN 223 223 CALL adv_x( zdt , zudy , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume 224 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) 224 CALL adv_y( zdt , zvdx , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) 225 225 ENDIF 226 226 ENDIF … … 245 245 END DO 246 246 DO jk = 1, nlay_i !--- ice heat content 247 CALL adv_y( zdt, zvdx, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 247 CALL adv_y( zdt, zvdx, 1._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 248 248 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 249 CALL adv_x( zdt, zudy, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 249 CALL adv_x( zdt, zudy, 0._wp, zarea, z0ei(:,:,jk,:), sxe(:,:,jk,:), & 250 250 & sxxe(:,:,jk,:), sye(:,:,jk,:), syye(:,:,jk,:), sxye(:,:,jk,:) ) 251 251 END DO … … 257 257 IF ( ln_pnd_lids ) THEN 258 258 CALL adv_y( zdt , zvdx , 1._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) !--- melt pond lid volume 259 CALL adv_x( zdt , zudy , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) 259 CALL adv_x( zdt , zudy , 0._wp , zarea , z0vl , sxvl , sxxvl , syvl , syyvl , sxyvl ) 260 260 ENDIF 261 261 ENDIF 262 262 ! 263 263 ENDIF 264 264 265 265 ! --- Lateral boundary conditions --- ! 266 266 ! caution: for gradients (sx and sy) the sign changes … … 276 276 & , sxxage, 'T', 1._wp, syyage, 'T', 1._wp, sxyage, 'T', 1._wp ) 277 277 CALL lbc_lnk_multi( 'icedyn_adv_pra', z0es , 'T', 1._wp, sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy 278 & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp ) 278 & , sxxc0 , 'T', 1._wp, syyc0 , 'T', 1._wp, sxyc0 , 'T', 1._wp ) 279 279 CALL lbc_lnk_multi( 'icedyn_adv_pra', z0ei , 'T', 1._wp, sxe , 'T', -1._wp, sye , 'T', -1._wp & ! ice enthalpy 280 280 & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp ) … … 283 283 & , sxxap, 'T', 1._wp, syyap, 'T', 1._wp, sxyap, 'T', 1._wp & 284 284 & , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp & ! melt pond volume 285 & , sxxvp, 'T', 1._wp, syyvp, 'T', 1._wp, sxyvp, 'T', 1._wp ) 285 & , sxxvp, 'T', 1._wp, syyvp, 'T', 1._wp, sxyvp, 'T', 1._wp ) 286 286 IF ( ln_pnd_lids ) THEN 287 287 CALL lbc_lnk_multi( 'icedyn_adv_pra', z0vl ,'T', 1._wp, sxvl ,'T', -1._wp, syvl ,'T', -1._wp & ! melt pond lid volume 288 & , sxxvl,'T', 1._wp, syyvl,'T', 1._wp, sxyvl,'T', 1._wp ) 288 & , sxxvl,'T', 1._wp, syyvl,'T', 1._wp, sxyvl,'T', 1._wp ) 289 289 ENDIF 290 290 ENDIF … … 348 348 ! 349 349 END SUBROUTINE ice_dyn_adv_pra 350 351 350 351 352 352 SUBROUTINE adv_x( pdt, put , pcrh, psm , ps0 , & 353 353 & psx, psxx, psy , psyy, psxy ) 354 354 !!---------------------------------------------------------------------- 355 355 !! ** routine adv_x ** 356 !! 356 !! 357 357 !! ** purpose : Computes and adds the advection trend to sea-ice 358 358 !! variable on x axis … … 363 363 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psm ! area 364 364 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ps0 ! field to be advected 365 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psx , psy ! 1st moments 365 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psx , psy ! 1st moments 366 366 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psxx, psyy, psxy ! 2nd moments 367 !! 367 !! 368 368 INTEGER :: ji, jj, jl, jcat ! dummy loop indices 369 369 INTEGER :: jj0 ! dummy loop indices … … 386 386 DO jl = 1, jcat ! loop on categories 387 387 ! 388 ! Limitation of moments. 388 ! Limitation of moments. 389 389 DO jj = Njs0 - jj0, Nje0 + jj0 390 390 391 391 DO ji = Nis0 - 1, Nie0 + 1 392 392 … … 399 399 zpsxy = psxy(ji,jj,jl) 400 400 401 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 401 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 402 402 zpsm = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * zpsm , epsi20 ) 403 403 ! … … 408 408 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 409 409 410 zps0 = zslpmax 410 zps0 = zslpmax 411 411 zpsx = zs1new * rswitch 412 412 zpsxx = zs2new * rswitch … … 415 415 zpsxy = MIN( zslpmax, MAX( -zslpmax, zpsxy ) ) * rswitch 416 416 417 ! Calculate fluxes and moments between boxes i<-->i+1 418 ! ! Flux from i to i+1 WHEN u GT 0 417 ! Calculate fluxes and moments between boxes i<-->i+1 418 ! ! Flux from i to i+1 WHEN u GT 0 419 419 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 420 420 zalf = MAX( 0._wp, put(ji,jj) ) * pdt / zpsm … … 423 423 zalf1q = zalf1 * zalf1 424 424 ! 425 zfm (ji,jj) = zalf * zpsm 425 zfm (ji,jj) = zalf * zpsm 426 426 zf0 (ji,jj) = zalf * ( zps0 + zalf1 * ( zpsx + (zalf1 - zalf) * zpsxx ) ) 427 427 zfx (ji,jj) = zalfq * ( zpsx + 3.0 * zalf1 * zpsxx ) … … 441 441 ! 442 442 psm (ji,jj,jl) = zpsm ! optimization 443 ps0 (ji,jj,jl) = zps0 444 psx (ji,jj,jl) = zpsx 443 ps0 (ji,jj,jl) = zps0 444 psx (ji,jj,jl) = zpsx 445 445 psxx(ji,jj,jl) = zpsxx 446 psy (ji,jj,jl) = zpsy 446 psy (ji,jj,jl) = zpsy 447 447 psyy(ji,jj,jl) = zpsyy 448 448 psxy(ji,jj,jl) = zpsxy 449 449 ! 450 450 END DO 451 451 452 452 DO ji = Nis0 - 1, Nie0 453 453 ! ! Flux from i+1 to i when u LT 0. 454 zalf = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 454 zalf = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 455 455 zalg (ji,jj) = zalf 456 456 zalfq = zalf * zalf … … 491 491 zpsxy = zalg1q(ji-1,jj) * zpsxy 492 492 493 ! Put the temporary moments into appropriate neighboring boxes. 493 ! Put the temporary moments into appropriate neighboring boxes. 494 494 ! ! Flux from i to i+1 IF u GT 0. 495 495 zbt = zbet(ji-1,jj) … … 508 508 & + 3.0 * (- zalf1*zfy(ji-1,jj) + zalf * zpsy ) ) & 509 509 & + zbt1 * zpsxy 510 zpsy = zbt * ( zpsy + zfy (ji-1,jj) ) + zbt1 * zpsy 510 zpsy = zbt * ( zpsy + zfy (ji-1,jj) ) + zbt1 * zpsy 511 511 zpsyy = zbt * ( zpsyy + zfyy(ji-1,jj) ) + zbt1 * zpsyy 512 512 … … 530 530 ! 531 531 psm (ji,jj,jl) = zpsm ! optimization 532 ps0 (ji,jj,jl) = zps0 533 psx (ji,jj,jl) = zpsx 532 ps0 (ji,jj,jl) = zps0 533 psx (ji,jj,jl) = zpsx 534 534 psxx(ji,jj,jl) = zpsxx 535 psy (ji,jj,jl) = zpsy 535 psy (ji,jj,jl) = zpsy 536 536 psyy(ji,jj,jl) = zpsyy 537 537 psxy(ji,jj,jl) = zpsxy … … 541 541 ! 542 542 END DO 543 ! 543 ! 544 544 END SUBROUTINE adv_x 545 545 … … 549 549 !!--------------------------------------------------------------------- 550 550 !! ** routine adv_y ** 551 !! 552 !! ** purpose : Computes and adds the advection trend to sea-ice 551 !! 552 !! ** purpose : Computes and adds the advection trend to sea-ice 553 553 !! variable on y axis 554 554 !!--------------------------------------------------------------------- … … 558 558 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psm ! area 559 559 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ps0 ! field to be advected 560 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psx , psy ! 1st moments 560 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psx , psy ! 1st moments 561 561 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: psxx, psyy, psxy ! 2nd moments 562 562 !! … … 578 578 ! 579 579 jcat = SIZE( ps0 , 3 ) ! size of input arrays 580 ! 580 ! 581 581 DO jl = 1, jcat ! loop on categories 582 582 ! … … 601 601 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 602 602 ! 603 zps0 = zslpmax 603 zps0 = zslpmax 604 604 zpsx = zpsx * rswitch 605 605 zpsxx = zpsxx * rswitch … … 608 608 zpsxy = MIN( zslpmax, MAX( -zslpmax, zpsxy ) ) * rswitch 609 609 610 ! Calculate fluxes and moments between boxes j<-->j+1 611 ! ! Flux from j to j+1 WHEN v GT 0 610 ! Calculate fluxes and moments between boxes j<-->j+1 611 ! ! Flux from j to j+1 WHEN v GT 0 612 612 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 613 613 zalf = MAX( 0._wp, pvt(ji,jj) ) * pdt / zpsm … … 617 617 ! 618 618 zfm (ji,jj) = zalf * zpsm 619 zf0 (ji,jj) = zalf * ( zps0 + zalf1 * ( zpsy + (zalf1-zalf) * zpsyy ) ) 619 zf0 (ji,jj) = zalf * ( zps0 + zalf1 * ( zpsy + (zalf1-zalf) * zpsyy ) ) 620 620 zfy (ji,jj) = zalfq *( zpsy + 3.0*zalf1*zpsyy ) 621 621 zfyy(ji,jj) = zalf * zalfq * zpsyy … … 634 634 ! 635 635 psm (ji,jj,jl) = zpsm ! optimization 636 ps0 (ji,jj,jl) = zps0 637 psx (ji,jj,jl) = zpsx 636 ps0 (ji,jj,jl) = zps0 637 psx (ji,jj,jl) = zpsx 638 638 psxx(ji,jj,jl) = zpsxx 639 psy (ji,jj,jl) = zpsy 639 psy (ji,jj,jl) = zpsy 640 640 psyy(ji,jj,jl) = zpsyy 641 641 psxy(ji,jj,jl) = zpsxy … … 644 644 DO_2D( 1, 0, ji0, ji0 ) 645 645 ! ! Flux from j+1 to j when v LT 0. 646 zalf = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 646 zalf = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 647 647 zalg (ji,jj) = zalf 648 648 zalfq = zalf * zalf … … 683 683 zpsxy = zalg1q(ji,jj-1) * zpsxy 684 684 685 ! Put the temporary moments into appropriate neighboring boxes. 685 ! Put the temporary moments into appropriate neighboring boxes. 686 686 ! ! Flux from j to j+1 IF v GT 0. 687 687 zbt = zbet(ji,jj-1) 688 688 zbt1 = 1.0 - zbet(ji,jj-1) 689 zpsm = zbt * ( zpsm + zfm(ji,jj-1) ) + zbt1 * zpsm 690 zalf = zbt * zfm(ji,jj-1) / zpsm 689 zpsm = zbt * ( zpsm + zfm(ji,jj-1) ) + zbt1 * zpsm 690 zalf = zbt * zfm(ji,jj-1) / zpsm 691 691 zalf1 = 1.0 - zalf 692 692 ztemp = zalf * zps0 - zalf1 * zf0(ji,jj-1) … … 694 694 zps0 = zbt * ( zps0 + zf0(ji,jj-1) ) + zbt1 * zps0 695 695 zpsy = zbt * ( zalf * zfy(ji,jj-1) + zalf1 * zpsy + 3.0 * ztemp ) & 696 & + zbt1 * zpsy 696 & + zbt1 * zpsy 697 697 zpsyy = zbt * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * zpsyy & 698 & + 5.0 * ( zalf * zalf1 * ( zpsy - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 698 & + 5.0 * ( zalf * zalf1 * ( zpsy - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) ) & 699 699 & + zbt1 * zpsyy 700 700 zpsxy = zbt * ( zalf * zfxy(ji,jj-1) + zalf1 * zpsxy & 701 701 & + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * zpsx ) ) & 702 702 & + zbt1 * zpsxy 703 zpsx = zbt * ( zpsx + zfx (ji,jj-1) ) + zbt1 * zpsx 703 zpsx = zbt * ( zpsx + zfx (ji,jj-1) ) + zbt1 * zpsx 704 704 zpsxx = zbt * ( zpsxx + zfxx(ji,jj-1) ) + zbt1 * zpsxx 705 705 … … 723 723 ! 724 724 psm (ji,jj,jl) = zpsm ! optimization 725 ps0 (ji,jj,jl) = zps0 726 psx (ji,jj,jl) = zpsx 725 ps0 (ji,jj,jl) = zps0 726 psx (ji,jj,jl) = zpsx 727 727 psxx(ji,jj,jl) = zpsxx 728 psy (ji,jj,jl) = zpsy 728 psy (ji,jj,jl) = zpsy 729 729 psyy(ji,jj,jl) = zpsyy 730 730 psxy(ji,jj,jl) = zpsxy … … 796 796 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 797 797 pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 798 ENDIF 799 ! 798 ENDIF 799 ! 800 800 ! ! -- check s_i -- ! 801 801 ! if s_i is larger than the surrounding 9 pts => put salt excess in the ocean … … 809 809 ENDIF 810 810 END_2D 811 END DO 811 END DO 812 812 ! 813 813 ! ! -- check e_i/v_i -- ! … … 899 899 !! *** ROUTINE adv_pra_init *** 900 900 !! 901 !! ** Purpose : allocate and initialize arrays for Prather advection 901 !! ** Purpose : allocate and initialize arrays for Prather advection 902 902 !!------------------------------------------------------------------- 903 903 INTEGER :: ierr … … 932 932 !!--------------------------------------------------------------------- 933 933 !! *** ROUTINE adv_pra_rst *** 934 !! 934 !! 935 935 !! ** Purpose : Read or write file in restart file 936 936 !! … … 991 991 DO jk = 1, nlay_s 992 992 WRITE(zchar1,'(I2.2)') jk 993 znam = 'sxc0'//'_l'//zchar1 993 znam = 'sxc0'//'_l'//zchar1 994 994 CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sxc0 (:,:,jk,:) = z3d(:,:,:) 995 znam = 'syc0'//'_l'//zchar1 995 znam = 'syc0'//'_l'//zchar1 996 996 CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; syc0 (:,:,jk,:) = z3d(:,:,:) 997 znam = 'sxxc0'//'_l'//zchar1 997 znam = 'sxxc0'//'_l'//zchar1 998 998 CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxc0(:,:,jk,:) = z3d(:,:,:) 999 znam = 'syyc0'//'_l'//zchar1 999 znam = 'syyc0'//'_l'//zchar1 1000 1000 CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syyc0(:,:,jk,:) = z3d(:,:,:) 1001 znam = 'sxyc0'//'_l'//zchar1 1001 znam = 'sxyc0'//'_l'//zchar1 1002 1002 CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxyc0(:,:,jk,:) = z3d(:,:,:) 1003 1003 END DO … … 1005 1005 DO jk = 1, nlay_i 1006 1006 WRITE(zchar1,'(I2.2)') jk 1007 znam = 'sxe'//'_l'//zchar1 1007 znam = 'sxe'//'_l'//zchar1 1008 1008 CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sxe (:,:,jk,:) = z3d(:,:,:) 1009 znam = 'sye'//'_l'//zchar1 1009 znam = 'sye'//'_l'//zchar1 1010 1010 CALL iom_get( numrir, jpdom_auto, znam , z3d, psgn = -1._wp ) ; sye (:,:,jk,:) = z3d(:,:,:) 1011 znam = 'sxxe'//'_l'//zchar1 1011 znam = 'sxxe'//'_l'//zchar1 1012 1012 CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxxe(:,:,jk,:) = z3d(:,:,:) 1013 znam = 'syye'//'_l'//zchar1 1013 znam = 'syye'//'_l'//zchar1 1014 1014 CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; syye(:,:,jk,:) = z3d(:,:,:) 1015 znam = 'sxye'//'_l'//zchar1 1015 znam = 'sxye'//'_l'//zchar1 1016 1016 CALL iom_get( numrir, jpdom_auto, znam , z3d ) ; sxye(:,:,jk,:) = z3d(:,:,:) 1017 1017 END DO … … 1165 1165 SUBROUTINE icemax3D( pice , pmax ) 1166 1166 !!--------------------------------------------------------------------- 1167 !! *** ROUTINE icemax3D *** 1167 !! *** ROUTINE icemax3D *** 1168 1168 !! ** Purpose : compute the max of the 9 points around 1169 1169 !!---------------------------------------------------------------------- … … 1174 1174 !!---------------------------------------------------------------------- 1175 1175 DO jl = 1, jpl 1176 DO jj = Njs0-1, Nje0+1 1176 DO jj = Njs0-1, Nje0+1 1177 1177 DO ji = Nis0, Nie0 1178 1178 zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) ) 1179 1179 END DO 1180 1180 END DO 1181 DO jj = Njs0, Nje0 1181 DO jj = Njs0, Nje0 1182 1182 DO ji = Nis0, Nie0 1183 1183 pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) … … 1189 1189 SUBROUTINE icemax4D( pice , pmax ) 1190 1190 !!--------------------------------------------------------------------- 1191 !! *** ROUTINE icemax4D *** 1191 !! *** ROUTINE icemax4D *** 1192 1192 !! ** Purpose : compute the max of the 9 points around 1193 1193 !!---------------------------------------------------------------------- … … 1200 1200 DO jl = 1, jpl 1201 1201 DO jk = 1, jlay 1202 DO jj = Njs0-1, Nje0+1 1202 DO jj = Njs0-1, Nje0+1 1203 1203 DO ji = Nis0, Nie0 1204 1204 zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) ) 1205 1205 END DO 1206 1206 END DO 1207 DO jj = Njs0, Nje0 1207 DO jj = Njs0, Nje0 1208 1208 DO ji = Nis0, Nie0 1209 1209 pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) )
Note: See TracChangeset
for help on using the changeset viewer.
