Changeset 13364 for NEMO/branches
- Timestamp:
- 2020-07-30T17:05:58+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE
- Files:
-
- 4 edited
-
DYN/dynhpg.F90 (modified) (20 diffs)
-
ISF/isf_oce.F90 (modified) (9 diffs)
-
ISF/isfload.F90 (modified) (10 diffs)
-
ISF/isfstp.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/DYN/dynhpg.F90
r13295 r13364 150 150 !! 151 151 INTEGER :: ji, jj, jk, ikt ! dummy loop indices ISF 152 REAL(wp) :: znad153 152 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zts_top, zrhd ! hypothesys on isf density 154 153 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zrhdtop_isf ! density at bottom of ISF … … 245 244 INTEGER :: ji, jj, jk ! dummy loop indices 246 245 REAL(wp) :: zcoef0, zcoef1 ! temporary scalars 247 REAL(wp), DIMENSION(jpi,jpj ,jpk) :: zhpi, zhpj246 REAL(wp), DIMENSION(jpi,jpj) :: zhpi, zhpj 248 247 !!---------------------------------------------------------------------- 249 248 ! … … 253 252 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ z-coordinate case ' 254 253 ENDIF 255 256 zcoef0 = - grav * 0.5_wp ! Local constant initialization 257 258 ! Surface value 259 DO_2D( 0, 0, 0, 0 ) 254 ! 255 zcoef0 = - grav * 0.5_wp ! Local constant initialization 256 ! 257 DO_2D( 0, 0, 0, 0 ) ! Surface value 260 258 zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm) 261 ! hydrostatic pressure gradient262 zhpi(ji,jj ,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj)263 zhpj(ji,jj ,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj)264 ! add to the general momentum trend265 puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj ,1)266 pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj ,1)259 ! ! hydrostatic pressure gradient 260 zhpi(ji,jj) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 261 zhpj(ji,jj) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 262 ! ! add to the general momentum trend 263 puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj) 264 pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj) 267 265 END_2D 268 269 ! 270 ! interior value (2=<jk=<jpkm1) 271 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 266 ! 267 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! interior value (2=<jk=<jpkm1) 272 268 zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm) 273 ! hydrostatic pressure gradient 274 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) & 275 & + zcoef1 * ( ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) ) & 276 & - ( rhd(ji ,jj,jk)+rhd(ji ,jj,jk-1) ) ) * r1_e1u(ji,jj) 277 278 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) & 279 & + zcoef1 * ( ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) ) & 280 & - ( rhd(ji,jj, jk)+rhd(ji,jj ,jk-1) ) ) * r1_e2v(ji,jj) 281 ! add to the general momentum trend 282 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk) 283 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk) 269 ! ! hydrostatic pressure gradient 270 zhpi(ji,jj) = zhpi(ji,jj) + zcoef1 * ( ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) ) & 271 & - ( rhd(ji ,jj,jk)+rhd(ji ,jj,jk-1) ) ) * r1_e1u(ji,jj) 272 273 zhpj(ji,jj) = zhpj(ji,jj) + zcoef1 * ( ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) ) & 274 & - ( rhd(ji,jj, jk)+rhd(ji,jj ,jk-1) ) ) * r1_e2v(ji,jj) 275 ! ! add to the general momentum trend 276 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj) 277 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj) 284 278 END_3D 285 279 ! … … 390 384 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation 391 385 !! 392 INTEGER :: ji, jj, jk, jii, jjj 393 REAL(wp) :: zcoef0, zuap, zvap, z nad, ztmp ! temporaryscalars394 LOGICAL :: ll_tmp1, ll_tmp2 386 INTEGER :: ji, jj, jk, jii, jjj ! dummy loop indices 387 REAL(wp) :: zcoef0, zuap, zvap, ztmp ! local scalars 388 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables 395 389 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 396 390 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zcpx, zcpy !W/D pressure filter … … 406 400 ! 407 401 zcoef0 = - grav * 0.5_wp 408 IF ( ln_linssh ) THEN ; znad = 0._wp ! Fixed volume: density anomaly409 ELSE ; znad = 1._wp ! Variable volume: density410 ENDIF411 402 ! 412 403 IF( ln_wd_il ) THEN … … 450 441 CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1.0_wp, zcpy, 'V', 1.0_wp ) 451 442 END IF 452 453 ! Surface value 454 DO_2D( 0, 0, 0, 0 ) 455 ! hydrostatic pressure gradient along s-surfaces 456 zhpi(ji,jj,1) = & 457 & zcoef0 * ( e3w(ji+1,jj ,1,Kmm) * ( znad + rhd(ji+1,jj ,1) ) & 458 & - e3w(ji ,jj ,1,Kmm) * ( znad + rhd(ji ,jj ,1) ) ) & 459 & * r1_e1u(ji,jj) 460 zhpj(ji,jj,1) = & 461 & zcoef0 * ( e3w(ji ,jj+1,1,Kmm) * ( znad + rhd(ji ,jj+1,1) ) & 462 & - e3w(ji ,jj ,1,Kmm) * ( znad + rhd(ji ,jj ,1) ) ) & 463 & * r1_e2v(ji,jj) 464 ! s-coordinate pressure gradient correction 465 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) & 443 ! 444 DO_2D( 0, 0, 0, 0 ) ! Surface value 445 ! ! hydrostatic pressure gradient along s-surfaces 446 zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) & 447 & * ( e3w(ji+1,jj ,1,Kmm) * rhd(ji+1,jj ,1) & 448 & - e3w(ji ,jj ,1,Kmm) * rhd(ji ,jj ,1) ) 449 zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) & 450 & * ( e3w(ji ,jj+1,1,Kmm) * rhd(ji ,jj+1,1) & 451 & - e3w(ji ,jj ,1,Kmm) * rhd(ji ,jj ,1) ) 452 ! ! s-coordinate pressure gradient correction 453 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) ) & 466 454 & * ( gde3w(ji+1,jj,1) - gde3w(ji,jj,1) ) * r1_e1u(ji,jj) 467 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) + 2._wp * znad) &455 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) ) & 468 456 & * ( gde3w(ji,jj+1,1) - gde3w(ji,jj,1) ) * r1_e2v(ji,jj) 469 457 ! … … 474 462 zvap = zvap * zcpy(ji,jj) 475 463 ENDIF 476 ! 477 ! add to the general momentum trend 464 ! ! add to the general momentum trend 478 465 puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1) + zuap 479 466 pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1) + zvap 480 467 END_2D 481 482 ! interior value (2=<jk=<jpkm1) 483 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 484 ! hydrostatic pressure gradient along s-surfaces 485 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj) & 486 & * ( e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) & 487 & - e3w(ji ,jj,jk,Kmm) * ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) + 2*znad ) ) 488 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj) & 489 & * ( e3w(ji,jj+1,jk,Kmm) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) & 490 & - e3w(ji,jj ,jk,Kmm) * ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) + 2*znad ) ) 491 ! s-coordinate pressure gradient correction 492 zuap = -zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 468 ! 469 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! interior value (2=<jk=<jpkm1) 470 ! ! hydrostatic pressure gradient along s-surfaces 471 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj) & 472 & * ( e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) ) & 473 & - e3w(ji ,jj,jk,Kmm) * ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) ) ) 474 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj) & 475 & * ( e3w(ji,jj+1,jk,Kmm) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) ) & 476 & - e3w(ji,jj ,jk,Kmm) * ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) ) ) 477 ! ! s-coordinate pressure gradient correction 478 zuap = -zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) ) & 493 479 & * ( gde3w(ji+1,jj ,jk) - gde3w(ji,jj,jk) ) * r1_e1u(ji,jj) 494 zvap = -zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) + 2._wp * znad )&480 zvap = -zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) ) & 495 481 & * ( gde3w(ji ,jj+1,jk) - gde3w(ji,jj,jk) ) * r1_e2v(ji,jj) 496 482 ! … … 535 521 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation 536 522 !! 537 INTEGER :: ji, jj, jk, ikt, iktp1i, iktp1j ! dummy loop indices 538 REAL(wp) :: zcoef0, zuap, zvap, znad ! temporary scalars 523 INTEGER :: ji, jj, jk ! dummy loop indices 524 INTEGER :: ikt , ikti1, iktj1 ! local integer 525 REAL(wp) :: ze3w, ze3wi1, ze3wj1 ! local scalars 526 REAL(wp) :: zcoef0, zuap, zvap ! - - 539 527 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zhpi, zhpj 540 528 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts_top … … 543 531 ! 544 532 zcoef0 = - grav * 0.5_wp ! Local constant initialization 545 !546 znad=1._wp ! To use density and not density anomaly547 533 ! 548 534 ! ! iniitialised to 0. zhpi zhpi … … 560 546 CALL eos( zts_top, risfdep, zrhdtop_oce ) 561 547 562 !================================================================================== 563 !===== Compute surface value ===================================================== 564 !================================================================================== 548 ! !===========================! 549 ! !===== surface value =====! 550 ! !===========================! 565 551 DO_2D( 0, 0, 0, 0 ) 566 ikt = mikt(ji,jj) 567 iktp1i = mikt(ji+1,jj) 568 iktp1j = mikt(ji,jj+1) 569 ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure 570 ! we assume ISF is in isostatic equilibrium 571 zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w(ji+1,jj,iktp1i,Kmm) & 572 & * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) ) & 573 & - 0.5_wp * e3w(ji,jj,ikt,Kmm) & 574 & * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) ) & 575 & + ( risfload(ji+1,jj) - risfload(ji,jj)) ) 576 zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w(ji,jj+1,iktp1j,Kmm) & 577 & * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) ) & 578 & - 0.5_wp * e3w(ji,jj,ikt,Kmm) & 579 & * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) ) & 580 & + ( risfload(ji,jj+1) - risfload(ji,jj)) ) 581 ! s-coordinate pressure gradient correction (=0 if z coordinate) 582 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) & 552 ikt = mikt(ji ,jj ) ; ze3w = e3w(ji ,jj ,ikt ,Kmm) 553 ikti1 = mikt(ji+1,jj ) ; ze3wi1 = e3w(ji+1,jj ,ikti1,Kmm) 554 iktj1 = mikt(ji ,jj+1) ; ze3wj1 = e3w(ji ,jj+1,iktj1,Kmm) 555 ! ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure 556 ! ! we assume ISF is in isostatic equilibrium 557 zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) * ( risfload(ji+1,jj) - risfload(ji,jj) & 558 & + 0.5_wp * ( ze3wi1 * ( rhd(ji+1,jj,ikti1) + zrhdtop_oce(ji+1,jj) ) & 559 & - ze3w * ( rhd(ji ,jj,ikt ) + zrhdtop_oce(ji ,jj) ) ) ) 560 zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) * ( risfload(ji,jj+1) - risfload(ji,jj) & 561 & + 0.5_wp * ( ze3wj1 * ( rhd(ji,jj+1,iktj1) + zrhdtop_oce(ji,jj+1) ) & 562 & - ze3w * ( rhd(ji,jj ,ikt ) + zrhdtop_oce(ji,jj ) ) ) ) 563 ! ! s-coordinate pressure gradient correction (=0 if z coordinate) 564 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) ) & 583 565 & * ( gde3w(ji+1,jj,1) - gde3w(ji,jj,1) ) * r1_e1u(ji,jj) 584 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) + 2._wp * znad) &566 zvap = -zcoef0 * ( rhd (ji,jj+1,1) + rhd (ji,jj,1) ) & 585 567 & * ( gde3w(ji,jj+1,1) - gde3w(ji,jj,1) ) * r1_e2v(ji,jj) 586 ! add to the general momentum trend568 ! ! add to the general momentum trend 587 569 puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + (zhpi(ji,jj,1) + zuap) * umask(ji,jj,1) 588 570 pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + (zhpj(ji,jj,1) + zvap) * vmask(ji,jj,1) 589 571 END_2D 590 !==================================================================================591 !===== Compute interior value ===================================================== 592 !================================================================================== 593 ! interior value (2=<jk=<jpkm1)572 ! 573 ! !=============================! 574 ! !===== interior values =====! 575 ! !=============================! 594 576 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 595 ! hydrostatic pressure gradient along s-surfaces 577 ze3w = e3w(ji ,jj ,jk,Kmm) 578 ze3wi1 = e3w(ji+1,jj ,jk,Kmm) 579 ze3wj1 = e3w(ji ,jj+1,jk,Kmm) 580 ! ! hydrostatic pressure gradient along s-surfaces 596 581 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj) & 597 & * ( e3w(ji+1,jj,jk,Kmm) & 598 & * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk) & 599 & - e3w(ji ,jj,jk,Kmm) & 600 & * ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) + 2*znad ) * wmask(ji ,jj,jk) ) 582 & * ( ze3wi1 * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) ) * wmask(ji+1,jj,jk) & 583 & - ze3w * ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) ) * wmask(ji ,jj,jk) ) 601 584 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj) & 602 & * ( e3w(ji,jj+1,jk,Kmm) & 603 & * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk) & 604 & - e3w(ji,jj ,jk,Kmm) & 605 & * ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) + 2*znad ) * wmask(ji,jj ,jk) ) 606 ! s-coordinate pressure gradient correction 607 zuap = -zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & 585 & * ( ze3wj1 * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) ) * wmask(ji,jj+1,jk) & 586 & - ze3w * ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) ) * wmask(ji,jj ,jk) ) 587 ! ! s-coordinate pressure gradient correction 588 zuap = -zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) ) & 608 589 & * ( gde3w(ji+1,jj ,jk) - gde3w(ji,jj,jk) ) / e1u(ji,jj) 609 zvap = -zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) + 2._wp * znad) &590 zvap = -zcoef0 * ( rhd (ji ,jj+1,jk) + rhd (ji,jj,jk) ) & 610 591 & * ( gde3w(ji ,jj+1,jk) - gde3w(ji,jj,jk) ) / e2v(ji,jj) 611 ! add to the general momentum trend592 ! ! add to the general momentum trend 612 593 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk) 613 594 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zhpj(ji,jj,jk) + zvap) * vmask(ji,jj,jk) … … 634 615 REAL(wp) :: z1_12, cffv, cffy ! " " 635 616 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables 617 REAL(wp), DIMENSION(jpi,jpj) :: zpgu, zpgv ! 2D workspace 636 618 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 637 619 REAL(wp), DIMENSION(jpi,jpj,jpk) :: dzx, dzy, dzz, dzu, dzv, dzw … … 826 808 END_3D 827 809 CALL lbc_lnk_multi( 'dynhpg', rho_k, 'W', 1.0_wp, rho_i, 'U', 1.0_wp, rho_j, 'V', 1.0_wp ) 828 810 ! 811 ! --------------- 812 ! Surface pressure gradient to be removed 813 ! --------------- 814 DO_2D( 0, 0, 0, 0 ) 815 zpgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 816 zpgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 817 END_2D 818 ! 829 819 ! --------------- 830 820 ! Surface value … … 838 828 ENDIF 839 829 ! add to the general momentum trend 840 puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1) 841 pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1) 830 puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1) - zpgu(ji,jj) 831 pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1) - zpgv(ji,jj) 842 832 END_2D 843 833 … … 858 848 ENDIF 859 849 ! add to the general momentum trend 860 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk) 861 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk) 850 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk) - zpgu(ji,jj) 851 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk) - zpgv(ji,jj) 862 852 END_3D 863 853 ! … … 892 882 REAL(wp) :: zrhdt1 893 883 REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 884 REAL(wp), DIMENSION(jpi,jpj) :: zpgu, zpgv ! 2D workspace 885 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_n, zsshv_n 894 886 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdept, zrhh 895 887 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 896 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_n, zsshv_n897 888 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zcpx, zcpy !W/D pressure filter 898 889 !!---------------------------------------------------------------------- … … 907 898 zcoef0 = - grav 908 899 znad = 1._wp 909 IF( ln_linssh ) znad = 0._wp 910 900 IF( ln_linssh ) znad = 1._wp 901 ! 902 ! --------------- 903 ! Surface pressure gradient to be removed 904 ! --------------- 905 DO_2D( 0, 0, 0, 0 ) 906 zpgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 907 zpgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 908 END_2D 909 ! 911 910 IF( ln_wd_il ) THEN 912 911 ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) … … 974 973 ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)" 975 974 DO_2D( 1, 1, 1, 1 ) 976 zdept(ji,jj,1) = 0.5_wp * e3w(ji,jj,1,Kmm) - ssh(ji,jj,Kmm) * znad975 zdept(ji,jj,1) = 0.5_wp * e3w(ji,jj,1,Kmm) - ssh(ji,jj,Kmm) 977 976 END_2D 978 977 … … 1025 1024 1026 1025 DO_2D( 0, 0, 0, 0 ) 1027 zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) * znad)1028 zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) * znad)1026 zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) ) 1027 zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) ) 1029 1028 END_2D 1030 1029 … … 1108 1107 zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj) 1109 1108 ENDIF 1110 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2 ) * umask(ji,jj,jk)1109 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2 - zpgu(ji,jj)) * umask(ji,jj,jk) 1111 1110 ENDIF 1112 1111 … … 1168 1167 ENDIF 1169 1168 1170 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zdpdy1 + zdpdy2 ) * vmask(ji,jj,jk)1169 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zdpdy1 + zdpdy2 - zpgv(ji,jj)) * vmask(ji,jj,jk) 1171 1170 ENDIF 1172 1171 ! -
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/ISF/isf_oce.F90
r12077 r13364 1 1 MODULE isf_oce 2 2 !!====================================================================== 3 !! *** MODULE sbcisf***4 !! Surface module : compute iceshelf melt and heat flux3 !! *** MODULE isf_oce *** 4 !! Ice shelves : ice shelves variables defined in memory 5 5 !!====================================================================== 6 6 !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav … … 146 146 END SUBROUTINE isf_alloc_par 147 147 148 148 149 SUBROUTINE isf_alloc_cav() 149 150 !!--------------------------------------------------------------------- … … 173 174 END SUBROUTINE isf_alloc_cav 174 175 176 175 177 SUBROUTINE isf_alloc_cpl() 176 178 !!--------------------------------------------------------------------- … … 184 186 ierr = 0 185 187 ! 186 ALLOCATE( risfcpl_ssh(jpi,jpj) , risfcpl_tsc(jpi,jpj,jpk,jpts), risfcpl_vol(jpi,jpj,jpk), STAT=ialloc )187 ierr = ierr + ialloc 188 ! 189 risfcpl_tsc(:,:,:,:) = 0. 0 ; risfcpl_vol(:,:,:) = 0.0 ; risfcpl_ssh(:,:) = 0.0190 191 IF ( ln_isfcpl_cons ) THEN192 ALLOCATE( risfcpl_cons_tsc(jpi,jpj,jpk,jpts) , risfcpl_cons_vol(jpi,jpj,jpk) , risfcpl_cons_ssh(jpi,jpj), STAT=ialloc )188 ALLOCATE( risfcpl_ssh(jpi,jpj) , risfcpl_tsc(jpi,jpj,jpk,jpts) , risfcpl_vol(jpi,jpj,jpk) , STAT=ialloc ) 189 ierr = ierr + ialloc 190 ! 191 risfcpl_tsc(:,:,:,:) = 0._wp ; risfcpl_vol(:,:,:) = 0._wp ; risfcpl_ssh(:,:) = 0._wp 192 193 IF ( ln_isfcpl_cons ) THEN 194 ALLOCATE( risfcpl_cons_tsc(jpi,jpj,jpk,jpts) , risfcpl_cons_vol(jpi,jpj,jpk) , risfcpl_cons_ssh(jpi,jpj) , STAT=ialloc ) 193 195 ierr = ierr + ialloc 194 196 ! 195 risfcpl_cons_tsc(:,:,:,:) = 0. 0 ; risfcpl_cons_vol(:,:,:) = 0.0 ; risfcpl_cons_ssh(:,:) = 0.0197 risfcpl_cons_tsc(:,:,:,:) = 0._wp ; risfcpl_cons_vol(:,:,:) = 0._wp ; risfcpl_cons_ssh(:,:) = 0._wp 196 198 ! 197 199 END IF … … 202 204 END SUBROUTINE isf_alloc_cpl 203 205 206 204 207 SUBROUTINE isf_dealloc_cpl() 205 208 !!--------------------------------------------------------------------- … … 213 216 ierr = 0 214 217 ! 215 DEALLOCATE( risfcpl_ssh , risfcpl_tsc, risfcpl_vol, STAT=ialloc )218 DEALLOCATE( risfcpl_ssh , risfcpl_tsc , risfcpl_vol , STAT=ialloc ) 216 219 ierr = ierr + ialloc 217 220 ! … … 221 224 END SUBROUTINE isf_dealloc_cpl 222 225 226 223 227 SUBROUTINE isf_alloc() 224 228 !!--------------------------------------------------------------------- … … 233 237 ierr = 0 ! set to zero if no array to be allocated 234 238 ! 235 ALLOCATE( fwfisf_par(jpi,jpj) , fwfisf_par_b(jpi,jpj),&236 & fwfisf_cav(jpi,jpj) , fwfisf_cav_b(jpi,jpj),&237 & fwfisf_oasis(jpi,jpj),STAT=ialloc )238 ierr = ierr + ialloc 239 ! 240 ALLOCATE( risf_par_tsc(jpi,jpj,jpts), risf_par_tsc_b(jpi,jpj,jpts), STAT=ialloc )241 ierr = ierr + ialloc 242 ! 243 ALLOCATE( risf_cav_tsc(jpi,jpj,jpts), risf_cav_tsc_b(jpi,jpj,jpts), STAT=ialloc )244 ierr = ierr + ialloc 245 ! 246 ALLOCATE( risfload(jpi,jpj), STAT=ialloc)247 ierr = ierr + ialloc 248 ! 249 ALLOCATE( mskisf_cav(jpi,jpj) , STAT=ialloc)239 ALLOCATE( fwfisf_par (jpi,jpj) , fwfisf_par_b(jpi,jpj) , & 240 & fwfisf_cav (jpi,jpj) , fwfisf_cav_b(jpi,jpj) , & 241 & fwfisf_oasis(jpi,jpj) , STAT=ialloc ) 242 ierr = ierr + ialloc 243 ! 244 ALLOCATE( risf_par_tsc(jpi,jpj,jpts) , risf_par_tsc_b(jpi,jpj,jpts) , STAT=ialloc ) 245 ierr = ierr + ialloc 246 ! 247 ALLOCATE( risf_cav_tsc(jpi,jpj,jpts) , risf_cav_tsc_b(jpi,jpj,jpts) , STAT=ialloc ) 248 ierr = ierr + ialloc 249 ! 250 ALLOCATE( risfload(jpi,jpj) , STAT=ialloc ) 251 ierr = ierr + ialloc 252 ! 253 ALLOCATE( mskisf_cav(jpi,jpj) , STAT=ialloc ) 250 254 ierr = ierr + ialloc 251 255 ! … … 254 258 ! 255 259 ! initalisation of fwf and tsc array to 0 256 risfload(:,:) = 0.0_wp 257 fwfisf_oasis(:,:) = 0.0_wp 258 fwfisf_par(:,:) = 0.0_wp ; fwfisf_par_b(:,:) = 0.0_wp 259 fwfisf_cav(:,:) = 0.0_wp ; fwfisf_cav_b(:,:) = 0.0_wp 260 risf_cav_tsc(:,:,:) = 0.0_wp ; risf_cav_tsc_b(:,:,:) = 0.0_wp 261 risf_par_tsc(:,:,:) = 0.0_wp ; risf_par_tsc_b(:,:,:) = 0.0_wp 262 ! 263 260 risfload (:,:) = 0._wp 261 fwfisf_oasis(:,:) = 0._wp 262 fwfisf_par (:,:) = 0._wp ; fwfisf_par_b (:,:) = 0._wp 263 fwfisf_cav (:,:) = 0._wp ; fwfisf_cav_b (:,:) = 0._wp 264 risf_cav_tsc(:,:,:) = 0._wp ; risf_cav_tsc_b(:,:,:) = 0._wp 265 risf_par_tsc(:,:,:) = 0._wp ; risf_par_tsc_b(:,:,:) = 0._wp 266 ! 264 267 END SUBROUTINE isf_alloc 265 268 269 !!====================================================================== 266 270 END MODULE isf_oce -
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/ISF/isfload.F90
r13295 r13364 2 2 !!====================================================================== 3 3 !! *** MODULE isfload *** 4 !! isfload module :compute ice shelf load (needed for the hpg)4 !! Ice Shelves : compute ice shelf load (needed for the hpg) 5 5 !!====================================================================== 6 6 !! History : 4.1 ! 2019-09 (P. Mathiot) original code … … 8 8 9 9 !!---------------------------------------------------------------------- 10 !! isf load : compute ice shelf load10 !! isf_load : compute ice shelf load 11 11 !!---------------------------------------------------------------------- 12 12 … … 23 23 PRIVATE 24 24 25 PUBLIC isf_load 25 PUBLIC isf_load ! called by isfstp.F90 26 ! 26 27 !! * Substitutions 27 28 # include "do_loop_substitute.h90" 28 29 # include "domzgr_substitute.h90" 29 30 !!---------------------------------------------------------------------- 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 32 !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $ 33 !! Software governed by the CeCILL license (see ./LICENSE) 34 !!---------------------------------------------------------------------- 30 35 CONTAINS 31 36 … … 37 42 !! 38 43 !!-------------------------------------------------------------------- 39 !!-------------------------- OUT ------------------------------------- 40 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pisfload 41 !!-------------------------- IN ------------------------------------- 42 INTEGER, INTENT(in) :: Kmm ! ocean time level index 44 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 45 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pisfload ! ice shelf load 43 46 !!---------------------------------------------------------------------- 44 47 ! … … 46 49 ! the smaller the residual flow is, the better it is. 47 50 ! 48 ! ice shelf cavity51 ! type of ice shelf cavity 49 52 SELECT CASE ( cn_isfload ) 50 53 CASE ( 'uniform' ) … … 56 59 END SUBROUTINE isf_load 57 60 58 SUBROUTINE isf_load_uniform( Kmm, pisfload ) 61 62 SUBROUTINE isf_load_uniform( Kmm, pload ) 59 63 !!-------------------------------------------------------------------- 60 64 !! *** SUBROUTINE isf_load *** … … 67 71 !! 68 72 !!-------------------------------------------------------------------- 69 !!-------------------------- OUT ------------------------------------- 70 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pisfload 71 !!-------------------------- IN ------------------------------------- 72 INTEGER, INTENT(in) :: Kmm ! ocean time level index 73 !!-------------------------------------------------------------------- 73 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 74 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pload ! ice shelf load 75 ! 74 76 INTEGER :: ji, jj, jk 75 77 INTEGER :: ikt 76 REAL(wp) :: znad !77 78 REAL(wp), DIMENSION(jpi,jpj) :: zrhdtop_isf ! water density displaced by the ice shelf (at the interface) 78 79 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts_top ! water properties displaced by the ice shelf 79 80 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrhd ! water density displaced by the ice shelf 80 81 !!---------------------------------------------------------------------- 81 !82 znad = 1._wp !- To use density and not density anomaly83 82 ! 84 83 ! !- assume water displaced by the ice shelf is at T=rn_isfload_T and S=rn_isfload_S (rude) … … 87 86 DO jk = 1, jpk !- compute density of the water displaced by the ice shelf 88 87 CALL eos( zts_top(:,:,:), gdept(:,:,jk,Kmm), zrhd(:,:,jk) ) 88 !!st ==>> CALL eos( zts_top(:,:,:), gdept_0(:,:,jk), zrhd(:,:,jk) ) 89 89 END DO 90 90 ! … … 93 93 ! 94 94 ! !- Surface value + ice shelf gradient 95 p isfload(:,:) = 0._wp! compute pressure due to ice shelf load95 pload(:,:) = 0._wp ! compute pressure due to ice shelf load 96 96 DO_2D( 1, 1, 1, 1 ) 97 97 ikt = mikt(ji,jj) 98 98 ! 99 99 IF ( ikt > 1 ) THEN 100 ! ! top layer of the ice shelf 101 pload(ji,jj) = pload(ji,jj) & 102 & + zrhd (ji,jj,1) * e3w(ji,jj,1,Kmm) 100 103 ! 101 ! top layer of the ice shelf 102 pisfload(ji,jj) = pisfload(ji,jj) + (znad + zrhd(ji,jj,1) ) & 103 & * e3w(ji,jj,1,Kmm) 104 ! 105 ! core layers of the ice shelf 106 DO jk = 2, ikt-1 107 pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) & 108 & * e3w(ji,jj,jk,Kmm) 104 DO jk = 2, ikt-1 ! core layers of the ice shelf 105 pload(ji,jj) = pload(ji,jj) + (zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) & 106 & * e3w(ji,jj,jk,Kmm) 109 107 END DO 110 ! 111 ! deepest part of the ice shelf (between deepest T point and ice/ocean interface112 pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) &113 & * ( risfdep(ji,jj) - gdept(ji,jj,ikt-1,Kmm) )108 ! ! deepest part of the ice shelf (between deepest T point and ice/ocean interface 109 pload(ji,jj) = pload(ji,jj) + ( zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1) ) & 110 & * ( risfdep(ji,jj) - gdept(ji,jj,ikt-1,Kmm) ) 111 !!st ==>> & * ( risfdep(ji,jj) - gdept_0(ji,jj,ikt-1) ) 114 112 ! 115 113 END IF … … 117 115 ! 118 116 END SUBROUTINE isf_load_uniform 119 117 118 !!====================================================================== 120 119 END MODULE isfload -
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/ISF/isfstp.F90
r13237 r13364 2 2 !!====================================================================== 3 3 !! *** MODULE isfstp *** 4 !! Surface module: compute iceshelf load, melt and heat flux4 !! Ice Shelves : compute iceshelf load, melt and heat flux 5 5 !!====================================================================== 6 6 !! History : 3.2 ! 2011-02 (C.Harris ) Original code isf cav … … 42 42 !! Software governed by the CeCILL license (see ./LICENSE) 43 43 !!---------------------------------------------------------------------- 44 45 44 CONTAINS 46 45 47 SUBROUTINE isf_stp( kt, Kmm )46 SUBROUTINE isf_stp( kt, Kmm ) 48 47 !!--------------------------------------------------------------------- 49 48 !! *** ROUTINE isf_stp *** … … 58 57 !! - compute fluxes 59 58 !! - write restart variables 60 !! 61 !!---------------------------------------------------------------------- 62 INTEGER, INTENT(in) :: kt ! ocean time step 63 INTEGER, INTENT(in) :: Kmm ! ocean time level index 64 !!---------------------------------------------------------------------- 65 INTEGER :: jk ! loop index 66 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t ! e3t 59 !!---------------------------------------------------------------------- 60 INTEGER, INTENT(in) :: kt ! ocean time step 61 INTEGER, INTENT(in) :: Kmm ! ocean time level index 62 ! 63 INTEGER :: jk ! loop index 64 #if defined key_qco 65 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t ! 3D workspace 66 #endif 67 67 !!--------------------------------------------------------------------- 68 68 ! … … 83 83 ! 1.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl) 84 84 rhisf_tbl_cav(:,:) = rn_htbl * mskisf_cav(:,:) 85 #if defined key_qco 85 86 DO jk = 1, jpk 86 87 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 87 88 END DO 88 CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav) 89 CALL isf_tbl_lvl( ht(:,:), ze3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 90 #else 91 CALL isf_tbl_lvl( ht(:,:), e3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 92 #endif 89 93 ! 90 94 ! 1.3: compute ice shelf melt 91 CALL isf_cav( kt, Kmm, risf_cav_tsc, fwfisf_cav )95 CALL isf_cav( kt, Kmm, risf_cav_tsc, fwfisf_cav ) 92 96 ! 93 97 END IF … … 108 112 ! by simplicity, we assume the top level where param applied do not change with time (done in init part) 109 113 rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:) 114 #if defined key_qco 110 115 DO jk = 1, jpk 111 116 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 112 117 END DO 113 CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par) 118 CALL isf_tbl_lvl( ht(:,:), ze3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 119 #else 120 CALL isf_tbl_lvl( ht(:,:), e3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 121 #endif 114 122 ! 115 123 ! 2.3: compute ice shelf melt 116 CALL isf_par( kt, Kmm, risf_par_tsc, fwfisf_par )124 CALL isf_par( kt, Kmm, risf_par_tsc, fwfisf_par ) 117 125 ! 118 126 END IF … … 128 136 END SUBROUTINE isf_stp 129 137 130 SUBROUTINE isf_init(Kbb, Kmm, Kaa) 138 139 SUBROUTINE isf_init( Kbb, Kmm, Kaa ) 131 140 !!--------------------------------------------------------------------- 132 141 !! *** ROUTINE isfstp_init *** … … 142 151 !! - call cav/param/isfcpl init routine 143 152 !!---------------------------------------------------------------------- 144 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 153 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 154 !!---------------------------------------------------------------------- 145 155 ! 146 156 ! constrain: l_isfoasis need to be known 147 157 ! 148 ! Read namelist 149 CALL isf_nam() 150 ! 151 ! Allocate public array 152 CALL isf_alloc() 153 ! 154 ! check option compatibility 155 CALL isf_ctl() 156 ! 157 ! compute ice shelf load 158 IF ( ln_isfcav ) CALL isf_load( Kmm, risfload ) 158 CALL isf_nam() ! Read namelist 159 ! 160 CALL isf_alloc() ! Allocate public array 161 ! 162 CALL isf_ctl() ! check option compatibility 163 ! 164 IF( ln_isfcav ) CALL isf_load( Kmm, risfload ) ! compute ice shelf load 159 165 ! 160 166 ! terminate routine now if no ice shelf melt formulation specify 161 IF ( ln_isf ) THEN 162 ! 163 !--------------------------------------------------------------------------------------------------------------------- 164 ! initialisation melt in the cavity 165 IF ( ln_isfcav_mlt ) CALL isf_cav_init() 166 ! 167 !--------------------------------------------------------------------------------------------------------------------- 168 ! initialisation parametrised melt 169 IF ( ln_isfpar_mlt ) CALL isf_par_init() 170 ! 171 !--------------------------------------------------------------------------------------------------------------------- 172 ! initialisation ice sheet coupling 173 IF( ln_isfcpl ) CALL isfcpl_init(Kbb, Kmm, Kaa) 167 IF( ln_isf ) THEN 168 ! 169 IF( ln_isfcav_mlt ) CALL isf_cav_init() ! initialisation melt in the cavity 170 ! 171 IF( ln_isfpar_mlt ) CALL isf_par_init() ! initialisation parametrised melt 172 ! 173 IF( ln_isfcpl ) CALL isfcpl_init( Kbb, Kmm, Kaa ) ! initialisation ice sheet coupling 174 174 ! 175 175 END IF … … 177 177 END SUBROUTINE isf_init 178 178 179 179 180 SUBROUTINE isf_ctl() 180 181 !!--------------------------------------------------------------------- … … 283 284 END IF 284 285 END SUBROUTINE isf_ctl 285 ! 286 287 286 288 SUBROUTINE isf_nam 287 289 !!---------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
