Changeset 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/ICE/icedyn_adv_umx.F90
- Timestamp:
- 2021-03-26T15:33:49+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/ICE/icedyn_adv_umx.F90 (modified) (40 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette _wave@13990sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/ICE/icedyn_adv_umx.F90
r14219 r14644 119 119 CALL icemax3D( ph_ip, zhip_max) 120 120 CALL icemax3D( zs_i , zsi_max ) 121 CALL lbc_lnk _multi( 'icedyn_adv_umx', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp )121 CALL lbc_lnk( 'icedyn_adv_umx', zhi_max, 'T', 1._wp, zhs_max, 'T', 1._wp, zhip_max, 'T', 1._wp, zsi_max, 'T', 1._wp ) 122 122 ! 123 123 ! enthalpies … … 360 360 ! --- Lateral boundary conditions --- ! 361 361 IF ( ( ln_pnd_LEV .OR. ln_pnd_TOPO ) .AND. ln_pnd_lids ) THEN 362 CALL lbc_lnk _multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp &363 & 362 CALL lbc_lnk( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 363 & , pa_ip,'T',1._wp, pv_ip,'T',1._wp, pv_il,'T',1._wp ) 364 364 ELSEIF( ( ln_pnd_LEV .OR. ln_pnd_TOPO ) .AND. .NOT.ln_pnd_lids ) THEN 365 CALL lbc_lnk _multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp &366 & 365 CALL lbc_lnk( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 366 & , pa_ip,'T',1._wp, pv_ip,'T',1._wp ) 367 367 ELSE 368 CALL lbc_lnk _multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp )368 CALL lbc_lnk( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp ) 369 369 ENDIF 370 370 CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp ) … … 491 491 IF( pamsk == 0._wp ) THEN 492 492 DO jl = 1, jpl 493 DO_2D( 0, 0, 1, 0 )493 DO_2D( 1, 0, 0, 0 ) 494 494 IF( ABS( pu(ji,jj) ) > epsi10 ) THEN 495 495 zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc (ji,jj,jl) / pu(ji,jj) … … 501 501 ! 502 502 END_2D 503 DO_2D( 1, 0, 0, 0 )503 DO_2D( 0, 0, 1, 0 ) 504 504 IF( ABS( pv(ji,jj) ) > epsi10 ) THEN 505 505 zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc (ji,jj,jl) / pv(ji,jj) … … 536 536 IF( PRESENT( pua_ho ) ) THEN 537 537 DO jl = 1, jpl 538 DO_2D( 0, 0, 1, 0 )538 DO_2D( 1, 0, 0, 0 ) 539 539 pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) 540 540 pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) 541 541 END_2D 542 DO_2D( 1, 0, 0, 0 )542 DO_2D( 0, 0, 1, 0 ) 543 543 pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 544 544 pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) … … 594 594 ! 595 595 DO jl = 1, jpl !-- flux in x-direction 596 DO_2D( 1, 1, 1, 0)596 DO_2D( 1, 0, 1, 1 ) 597 597 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 598 598 END_2D … … 600 600 ! 601 601 DO jl = 1, jpl !-- first guess of tracer from u-flux 602 DO_2D( 1, 1, 0, 0)602 DO_2D( 0, 0, 1, 1 ) 603 603 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) ) & 604 604 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 609 609 ! 610 610 DO jl = 1, jpl !-- flux in y-direction 611 DO_2D( 1, 0, 0, 0 )611 DO_2D( 0, 0, 1, 0 ) 612 612 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl) 613 613 END_2D … … 617 617 ! 618 618 DO jl = 1, jpl !-- flux in y-direction 619 DO_2D( 1, 0, 1, 1)619 DO_2D( 1, 1, 1, 0 ) 620 620 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 621 621 END_2D … … 623 623 ! 624 624 DO jl = 1, jpl !-- first guess of tracer from v-flux 625 DO_2D( 0, 0, 1, 1)625 DO_2D( 1, 1, 0, 0 ) 626 626 ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) ) & 627 627 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 632 632 ! 633 633 DO jl = 1, jpl !-- flux in x-direction 634 DO_2D( 0, 0, 1, 0 )634 DO_2D( 1, 0, 0, 0 ) 635 635 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl) 636 636 END_2D … … 681 681 ! 682 682 DO jl = 1, jpl 683 DO_2D( 1, 0, 1, 1 ) 684 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj ,jl) ) 685 END_2D 683 686 DO_2D( 1, 1, 1, 0 ) 684 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj ,jl) )685 END_2D686 DO_2D( 1, 0, 1, 1 )687 687 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji ,jj+1,jl) ) 688 688 END_2D … … 701 701 ! 702 702 DO jl = 1, jpl !-- flux in x-direction 703 DO_2D( 1, 1, 1, 0)703 DO_2D( 1, 0, 1, 1 ) 704 704 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 705 705 END_2D … … 708 708 709 709 DO jl = 1, jpl !-- first guess of tracer from u-flux 710 DO_2D( 1, 1, 0, 0)710 DO_2D( 0, 0, 1, 1 ) 711 711 ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) ) & 712 712 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 717 717 718 718 DO jl = 1, jpl !-- flux in y-direction 719 DO_2D( 1, 0, 0, 0 )719 DO_2D( 0, 0, 1, 0 ) 720 720 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 721 721 END_2D … … 726 726 ! 727 727 DO jl = 1, jpl !-- flux in y-direction 728 DO_2D( 1, 0, 1, 1)728 DO_2D( 1, 1, 1, 0 ) 729 729 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 730 730 END_2D … … 733 733 ! 734 734 DO jl = 1, jpl !-- first guess of tracer from v-flux 735 DO_2D( 0, 0, 1, 1)735 DO_2D( 1, 1, 0, 0 ) 736 736 ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) ) & 737 737 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 742 742 ! 743 743 DO jl = 1, jpl !-- flux in x-direction 744 DO_2D( 0, 0, 1, 0 )744 DO_2D( 1, 0, 0, 0 ) 745 745 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 746 746 END_2D … … 899 899 ! 900 900 DO jl = 1, jpl 901 DO_2D( 0, 0, 1, 0 )901 DO_2D( 1, 0, 0, 0 ) 902 902 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 903 903 & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) … … 908 908 ! 909 909 DO jl = 1, jpl 910 DO_2D( 0, 0, 1, 0 )910 DO_2D( 1, 0, 0, 0 ) 911 911 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 912 912 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & … … 918 918 ! 919 919 DO jl = 1, jpl 920 DO_2D( 0, 0, 1, 0 )920 DO_2D( 1, 0, 0, 0 ) 921 921 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 922 922 zdx2 = e1u(ji,jj) * e1u(ji,jj) … … 932 932 ! 933 933 DO jl = 1, jpl 934 DO_2D( 0, 0, 1, 0 )934 DO_2D( 1, 0, 0, 0 ) 935 935 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 936 936 zdx2 = e1u(ji,jj) * e1u(ji,jj) … … 946 946 ! 947 947 DO jl = 1, jpl 948 DO_2D( 0, 0, 1, 0 )948 DO_2D( 1, 0, 0, 0 ) 949 949 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 950 950 zdx2 = e1u(ji,jj) * e1u(ji,jj) … … 967 967 IF( ll_neg ) THEN 968 968 DO jl = 1, jpl 969 DO_2D( 0, 0, 1, 0 )969 DO_2D( 1, 0, 0, 0 ) 970 970 IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 971 971 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & … … 977 977 ! !-- High order flux in i-direction --! 978 978 DO jl = 1, jpl 979 DO_2D( 0, 0, 1, 0 )979 DO_2D( 1, 0, 0, 0 ) 980 980 pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl) 981 981 END_2D … … 1010 1010 ! !-- Laplacian in j-direction --! 1011 1011 DO jl = 1, jpl 1012 DO_2D( 1, 0, 0, 0 ) ! First derivative (gradient)1012 DO_2D( 0, 0, 1, 0 ) ! First derivative (gradient) 1013 1013 ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 1014 1014 END_2D … … 1021 1021 ! !-- BiLaplacian in j-direction --! 1022 1022 DO jl = 1, jpl 1023 DO_2D( 1, 0, 0, 0 ) ! First derivative1023 DO_2D( 0, 0, 1, 0 ) ! First derivative 1024 1024 ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 1025 1025 END_2D … … 1035 1035 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 1036 1036 DO jl = 1, jpl 1037 DO_2D( 1, 0, 0, 0 )1037 DO_2D( 0, 0, 1, 0 ) 1038 1038 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & 1039 1039 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) … … 1043 1043 CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23) 1044 1044 DO jl = 1, jpl 1045 DO_2D( 1, 0, 0, 0 )1045 DO_2D( 0, 0, 1, 0 ) 1046 1046 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1047 1047 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & … … 1052 1052 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 1053 1053 DO jl = 1, jpl 1054 DO_2D( 1, 0, 0, 0 )1054 DO_2D( 0, 0, 1, 0 ) 1055 1055 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1056 1056 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 1065 1065 CASE( 4 ) !== 4th order central TIM ==! (Eq. 27) 1066 1066 DO jl = 1, jpl 1067 DO_2D( 1, 0, 0, 0 )1067 DO_2D( 0, 0, 1, 0 ) 1068 1068 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1069 1069 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 1078 1078 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 1079 1079 DO jl = 1, jpl 1080 DO_2D( 1, 0, 0, 0 )1080 DO_2D( 0, 0, 1, 0 ) 1081 1081 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1082 1082 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 1099 1099 IF( ll_neg ) THEN 1100 1100 DO jl = 1, jpl 1101 DO_2D( 1, 0, 0, 0 )1101 DO_2D( 0, 0, 1, 0 ) 1102 1102 IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 1103 1103 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl) + pt(ji,jj,jl) ) & … … 1109 1109 ! !-- High order flux in j-direction --! 1110 1110 DO jl = 1, jpl 1111 DO_2D( 1, 0, 0, 0 )1111 DO_2D( 0, 0, 1, 0 ) 1112 1112 pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl) 1113 1113 END_2D … … 1145 1145 ! -------------------------------------------------- 1146 1146 DO jl = 1, jpl 1147 DO_2D( 1, 0, 0, 0 ) 1148 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 1149 END_2D 1147 1150 DO_2D( 0, 0, 1, 0 ) 1148 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl)1149 END_2D1150 DO_2D( 1, 0, 0, 0 )1151 1151 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 1152 1152 END_2D … … 1169 1169 END_2D 1170 1170 END DO 1171 CALL lbc_lnk _multi( 'icedyn_adv_umx', zti_ups, 'T', 1.0_wp, ztj_ups, 'T', 1.0_wp )1171 CALL lbc_lnk( 'icedyn_adv_umx', zti_ups, 'T', 1.0_wp, ztj_ups, 'T', 1.0_wp ) 1172 1172 1173 1173 DO jl = 1, jpl … … 1191 1191 END_2D 1192 1192 END DO 1193 CALL lbc_lnk _multi( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp, pfv_ho, 'V', -1.0_wp ) ! lateral boundary cond.1193 CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp, pfv_ho, 'V', -1.0_wp ) ! lateral boundary cond. 1194 1194 1195 1195 ENDIF … … 1248 1248 END_2D 1249 1249 END DO 1250 CALL lbc_lnk _multi( 'icedyn_adv_umx', zbetup, 'T', 1.0_wp, zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign)1250 CALL lbc_lnk( 'icedyn_adv_umx', zbetup, 'T', 1.0_wp, zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign) 1251 1251 1252 1252 … … 1254 1254 ! --------------------------------- 1255 1255 DO jl = 1, jpl 1256 DO_2D( 0, 0, 1, 0 )1256 DO_2D( 1, 0, 0, 0 ) 1257 1257 zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) ) 1258 1258 zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) ) … … 1265 1265 END_2D 1266 1266 1267 DO_2D( 1, 0, 0, 0 )1267 DO_2D( 0, 0, 1, 0 ) 1268 1268 zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) ) 1269 1269 zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) )
Note: See TracChangeset
for help on using the changeset viewer.
