Changeset 10425 for NEMO/trunk/tests/CANAL/MY_SRC/domvvl.F90
- Timestamp:
- 2018-12-19T22:54:16+01:00 (6 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/tests/CANAL/MY_SRC/domvvl.F90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/tests/CANAL/MY_SRC/domvvl.F90
r10074 r10425 79 79 & dtilde_e3t_a(jpi,jpj,jpk) , un_td (jpi,jpj,jpk) , vn_td (jpi,jpj,jpk) , & 80 80 & STAT = dom_vvl_alloc ) 81 IF( lk_mpp ) CALL mpp_sum (dom_vvl_alloc )82 IF( dom_vvl_alloc /= 0 ) CALL ctl_ warn('dom_vvl_alloc: failed to allocate arrays')81 CALL mpp_sum ( 'domvvl', dom_vvl_alloc ) 82 IF( dom_vvl_alloc /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_alloc: failed to allocate arrays' ) 83 83 un_td = 0._wp 84 84 vn_td = 0._wp … … 86 86 IF( ln_vvl_ztilde ) THEN 87 87 ALLOCATE( frq_rst_e3t(jpi,jpj) , frq_rst_hdv(jpi,jpj) , hdiv_lf(jpi,jpj,jpk) , STAT= dom_vvl_alloc ) 88 IF( lk_mpp ) CALL mpp_sum (dom_vvl_alloc )89 IF( dom_vvl_alloc /= 0 ) CALL ctl_ warn('dom_vvl_alloc: failed to allocate arrays')88 CALL mpp_sum ( 'domvvl', dom_vvl_alloc ) 89 IF( dom_vvl_alloc /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_alloc: failed to allocate arrays' ) 90 90 ENDIF 91 91 ! … … 147 147 CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) ! from V to UW 148 148 CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 149 150 ! We need to define e3[tuv]_a for AGRIF initialisation (should not be a problem for the restartability...) 151 e3t_a(:,:,:) = e3t_n(:,:,:) 152 e3u_a(:,:,:) = e3u_n(:,:,:) 153 e3v_a(:,:,:) = e3v_n(:,:,:) 149 154 ! 150 155 ! !== depth of t and w-point ==! (set the isf depth as it is in the initial timestep) … … 229 234 END DO 230 235 END DO 231 IF( cn_cfg == "orca" .AND. nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 232 ii0 = 103 ; ii1 = 111 233 ij0 = 128 ; ij1 = 135 ; 234 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 235 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rdt 236 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 237 IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 238 ii0 = 103 ; ii1 = 111 239 ij0 = 128 ; ij1 = 135 ; 240 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp 241 frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0_wp / rdt 242 ENDIF 236 243 ENDIF 237 244 ENDIF 245 ENDIF 246 ! 247 IF(lwxios) THEN 248 ! define variables in restart file when writing with XIOS 249 CALL iom_set_rstw_var_active('e3t_b') 250 CALL iom_set_rstw_var_active('e3t_n') 251 ! ! ----------------------- ! 252 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 253 ! ! ----------------------- ! 254 CALL iom_set_rstw_var_active('tilde_e3t_b') 255 CALL iom_set_rstw_var_active('tilde_e3t_n') 256 END IF 257 ! ! -------------! 258 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 259 ! ! ------------ ! 260 CALL iom_set_rstw_var_active('hdiv_lf') 261 ENDIF 262 ! 238 263 ENDIF 239 264 ! … … 385 410 ! ! d - thickness diffusion transport: boundary conditions 386 411 ! (stored for tracer advction and continuity equation) 387 CALL lbc_lnk_multi( un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp)412 CALL lbc_lnk_multi( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 388 413 389 414 ! 4 - Time stepping of baroclinic scale factors … … 396 421 z2dt = 2.0_wp * rdt 397 422 ENDIF 398 CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp )423 CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 399 424 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 400 425 … … 406 431 END DO 407 432 z_tmax = MAXVAL( ze3t(:,:,:) ) 408 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain433 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 409 434 z_tmin = MINVAL( ze3t(:,:,:) ) 410 IF( lk_mpp ) CALL mpp_min(z_tmin ) ! min over the global domain435 CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 411 436 ! - ML - test: for the moment, stop simulation for too large e3_t variations 412 437 IF( ( z_tmax > rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 413 438 IF( lk_mpp ) THEN 414 CALL mpp_maxloc( ze3t, tmask, z_tmax, ijk_max(1), ijk_max(2), ijk_max(3))415 CALL mpp_minloc( ze3t, tmask, z_tmin, ijk_min(1), ijk_min(2), ijk_min(3))439 CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 440 CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 416 441 ELSE 417 442 ijk_max = MAXLOC( ze3t(:,:,:) ) … … 427 452 WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 428 453 WRITE(numout, *) 'at i, j, k=', ijk_min 429 CALL ctl_ warn('MAX( ABS( tilde_e3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high')454 CALL ctl_stop( 'STOP', 'MAX( ABS( tilde_e3t_a(:,:,: ) ) / e3t_0(:,:,:) ) too high') 430 455 ENDIF 431 456 ENDIF … … 470 495 IF ( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 471 496 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) ) 472 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain497 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 473 498 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(tilde_e3t_a))) =', z_tmax 474 499 END IF … … 479 504 END DO 480 505 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 481 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain506 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 482 507 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax 483 508 ! … … 487 512 END DO 488 513 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 489 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain514 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 490 515 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax 491 516 ! … … 495 520 END DO 496 521 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) ) 497 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain522 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 498 523 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t_b))) =', z_tmax 499 524 ! 500 525 z_tmax = MAXVAL( tmask(:,:,1) * ABS( sshb(:,:) ) ) 501 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain526 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 502 527 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(sshb))) =', z_tmax 503 528 ! 504 529 z_tmax = MAXVAL( tmask(:,:,1) * ABS( sshn(:,:) ) ) 505 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain530 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 506 531 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(sshn))) =', z_tmax 507 532 ! 508 533 z_tmax = MAXVAL( tmask(:,:,1) * ABS( ssha(:,:) ) ) 509 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain534 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 510 535 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ssha))) =', z_tmax 511 536 END IF … … 688 713 END DO 689 714 END DO 690 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp )715 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 691 716 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 692 717 ! … … 701 726 END DO 702 727 END DO 703 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp )728 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 704 729 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 705 730 ! … … 715 740 END DO 716 741 END DO 717 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp )742 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 718 743 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 719 744 ! … … 781 806 IF( ln_rstart ) THEN !* Read the restart file 782 807 CALL rst_read_open ! open the restart file if necessary 783 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn )808 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn, ldxios = lrxios ) 784 809 ! 785 810 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 792 817 ! ! --------- ! 793 818 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 794 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) )795 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) )819 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:), ldxios = lrxios ) 820 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:), ldxios = lrxios ) 796 821 ! needed to restart if land processor not computed 797 822 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t_b and e3t_n found in restart files' … … 807 832 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 808 833 IF(lwp) write(numout,*) 'neuler is forced to 0' 809 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) )834 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:), ldxios = lrxios ) 810 835 e3t_n(:,:,:) = e3t_b(:,:,:) 811 836 neuler = 0 … … 814 839 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 815 840 IF(lwp) write(numout,*) 'neuler is forced to 0' 816 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) )841 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:), ldxios = lrxios ) 817 842 e3t_b(:,:,:) = e3t_n(:,:,:) 818 843 neuler = 0 … … 839 864 ! ! ----------------------- ! 840 865 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 841 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:) )842 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:) )866 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 867 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 843 868 ELSE ! one at least array is missing 844 869 tilde_e3t_b(:,:,:) = 0.0_wp … … 849 874 ! ! ------------ ! 850 875 IF( id5 > 0 ) THEN ! required array exists 851 CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:) )876 CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 852 877 ELSE ! array is missing 853 878 hdiv_lf(:,:,:) = 0.0_wp … … 929 954 ! ! =================== 930 955 IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 956 IF( lwxios ) CALL iom_swap( cwxios_context ) 931 957 ! ! --------- ! 932 958 ! ! all cases ! 933 959 ! ! --------- ! 934 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:) )935 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) )960 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:), ldxios = lwxios ) 961 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios ) 936 962 ! ! ----------------------- ! 937 963 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 938 964 ! ! ----------------------- ! 939 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) 940 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) 965 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lwxios) 966 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lwxios) 941 967 END IF 942 968 ! ! -------------! 943 969 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 944 970 ! ! ------------ ! 945 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) ) 946 ENDIF 947 ! 971 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lwxios) 972 ENDIF 973 ! 974 IF( lwxios ) CALL iom_swap( cxios_context ) 948 975 ENDIF 949 976 !
Note: See TracChangeset
for help on using the changeset viewer.
