- Timestamp:
- 2016-11-15T17:44:18+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/grid_zgr.f90
r7153 r7233 55 55 !> - J, Paul : update from trunk (revision 6961): add wetting and drying, ice sheet coupling.. 56 56 !> - J, Paul : do not use anymore special case for ORCA grid. 57 !> @date November, 2016 58 !> - J, Paul : vertical scale factors e3. = dk[gdep] or old definition 57 59 !> 58 60 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 99 101 PUBLIC :: tg_e3v_0 100 102 PUBLIC :: tg_e3w_0 101 !PUBLIC :: tg_e3f_0 !useless to create meshmask102 !PUBLIC :: tg_e3uw_0 !useless to create meshmask103 !PUBLIC :: tg_e3vw_0 !useless to create meshmask103 PUBLIC :: tg_e3f_0 !useless to create meshmask 104 PUBLIC :: tg_e3uw_0 !useless to create meshmask 105 PUBLIC :: tg_e3vw_0 !useless to create meshmask 104 106 105 107 PUBLIC :: tg_mbkt … … 144 146 PRIVATE :: grid_zgr__isf_fill 145 147 ! PRIVATE :: grid_zgr__isf_fill_e3x 146 !PRIVATE :: grid_zgr__isf_fill_e3uw148 PRIVATE :: grid_zgr__isf_fill_e3uw 147 149 ! PRIVATE :: grid_zgr__isf_fill_gdep3w_0 148 150 PRIVATE :: grid_zgr__sco_fill … … 155 157 156 158 TYPE TNAMZ 159 157 160 CHARACTER(LEN=lc) :: c_coord 158 161 INTEGER(i4) :: i_perio … … 214 217 ! LOGICAL :: l_zoom 215 218 LOGICAL :: l_c1d 219 LOGICAL :: l_e3_dep 216 220 217 221 ! CHARACTER(LEN=lc) :: c_cfz … … 244 248 TYPE(TVAR), SAVE :: tg_e3v_0 ! zps & sco 245 249 TYPE(TVAR), SAVE :: tg_e3w_0 ! zps & sco 246 !TYPE(TVAR), SAVE :: tg_e3f_0247 !TYPE(TVAR), SAVE :: tg_e3uw_0248 !TYPE(TVAR), SAVE :: tg_e3vw_0250 TYPE(TVAR), SAVE :: tg_e3f_0 251 TYPE(TVAR), SAVE :: tg_e3uw_0 252 TYPE(TVAR), SAVE :: tg_e3vw_0 249 253 250 254 TYPE(TVAR), SAVE :: tg_mbkt !zco & zps & sco … … 315 319 dl_tmp2D(:,:) =dp_fill_i2 316 320 317 tg_mbathy =var_init('mbathy ',dl_tmp2D(:,:) , dd_fill=dp_fill_i2, id_type=NF90_SHORT)318 tg_misfdep =var_init('misfdep ',dl_tmp2D(:,:) , dd_fill=dp_fill_i2, id_type=NF90_SHORT)319 320 321 tg_mbkt =var_init('mbkt ',dl_tmp2D(:,:) , dd_fill=dp_fill_i2, id_type=NF90_SHORT) 321 322 !tg_mbku =var_init('mbku ',dl_tmp2D(:,:) , dd_fill=dp_fill_i2, id_type=NF90_SHORT) … … 326 327 !tg_mikf =var_init('mikf ',dl_tmp2D(:,:) , dd_fill=dp_fill_i2, id_type=NF90_SHORT) 327 328 329 dl_tmp2D(:,:) =dp_fill_i4 330 331 tg_mbathy =var_init('mbathy ',dl_tmp2D(:,:) , dd_fill=dp_fill_i4, id_type=NF90_INT) 332 tg_misfdep =var_init('misfdep ',dl_tmp2D(:,:) , dd_fill=dp_fill_i4, id_type=NF90_INT) 333 328 334 dl_tmp2D(:,:) =dp_fill 329 335 … … 337 343 338 344 ! variable 3D 339 dl_tmp3D(:,:,:)=dp_fill _sp340 341 tg_gdept_0 =var_init('gdept_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill _sp, id_type=NF90_FLOAT)342 tg_gdepw_0 =var_init('gdepw_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill _sp, id_type=NF90_FLOAT)345 dl_tmp3D(:,:,:)=dp_fill 346 347 tg_gdept_0 =var_init('gdept_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE) 348 tg_gdepw_0 =var_init('gdepw_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE) 343 349 !tg_gdep3w_0=var_init('gdep3w_0',dl_tmp3D(:,:,:), dd_fill=dp_fill_sp, id_type=NF90_FLOAT) 344 350 345 dl_tmp3D(:,:,:)=dp_fill346 347 351 tg_e3t_0 =var_init('e3t_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE) 348 352 tg_e3u_0 =var_init('e3u_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE) 349 353 tg_e3v_0 =var_init('e3v_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE) 350 354 tg_e3w_0 =var_init('e3w_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE) 351 !tg_e3f_0 =var_init('e3f_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)352 !tg_e3uw_0 =var_init('e3uw_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)353 !tg_e3vw_0 =var_init('e3vw_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE)355 tg_e3f_0 =var_init('e3f_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE) 356 tg_e3uw_0 =var_init('e3uw_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE) 357 tg_e3vw_0 =var_init('e3vw_0 ',dl_tmp3D(:,:,:), dd_fill=dp_fill, id_type=NF90_DOUBLE) 354 358 355 359 END SUBROUTINE grid_zgr_init … … 409 413 CALL var_clean(tg_e3u_0 ) 410 414 CALL var_clean(tg_e3v_0 ) 411 !CALL var_clean(tg_e3f_0 )412 !CALL var_clean(tg_e3uw_0 )413 !CALL var_clean(tg_e3vw_0 )415 CALL var_clean(tg_e3f_0 ) 416 CALL var_clean(tg_e3uw_0 ) 417 CALL var_clean(tg_e3vw_0 ) 414 418 415 419 END SUBROUTINE grid_zgr_clean … … 493 497 REAL(dp) :: dn_zb_b = NF90_FILL_DOUBLE 494 498 495 ! namcla496 INTEGER(i4) :: in_cla = 0499 ! ! namcla 500 ! INTEGER(i4) :: in_cla = 0 497 501 498 502 ! namwd … … 507 511 ! LOGICAL :: ln_zoom = .FALSE. 508 512 LOGICAL :: ln_c1d = .FALSE. 513 LOGICAL :: ln_e3_dep = .FALSE. 509 514 510 515 ! ! namzoom … … 568 573 & dn_zb_b !< offset for calculating Zb 569 574 570 NAMELIST /namcla/ &571 & in_cla !< =1 cross land advection for exchanges through some straits (ORCA2)575 ! NAMELIST /namcla/ & 576 ! & in_cla !< =1 cross land advection for exchanges through some straits (ORCA2) 572 577 573 578 NAMELIST /namwd/ & !< wetting and drying … … 581 586 ! & in_bench, & !< benchmark parameter (in_mshhgr = 5 ) 582 587 ! & ln_zoom, & !< use zoom 583 & ln_c1d !< use configuration 1D 588 & ln_c1d, & !< use configuration 1D 589 & ln_e3_dep !< new vertical scale factors [T, F:old definition] 584 590 585 591 ! NAMELIST /namzoom/& … … 616 622 IF( ln_zps ) READ( il_fileid, NML = namzps ) 617 623 IF( ln_sco ) READ( il_fileid, NML = namsco ) 618 READ( il_fileid, NML = namcla )624 ! READ( il_fileid, NML = namcla ) 619 625 READ( il_fileid, NML = namwd ) 620 626 READ( il_fileid, NML = namgrd ) … … 676 682 grid_zgr_nam%d_zb_b = dn_zb_b 677 683 678 grid_zgr_nam%i_cla = in_cla684 ! grid_zgr_nam%i_cla = in_cla 679 685 680 686 grid_zgr_nam%d_wdmin1 = dn_wdmin1 … … 687 693 ! grid_zgr_nam%l_zoom = ln_zoom 688 694 grid_zgr_nam%l_c1d = ln_c1d 695 grid_zgr_nam%l_e3_dep = ln_e3_dep 689 696 690 697 ! grid_zgr_nam%c_cfz = cn_cfz … … 743 750 CALL logger_info(' s- or hybrid z-s-coordinate ln_sco = '//TRIM(fct_str(td_nam%l_sco))) 744 751 CALL logger_info(' ice shelf cavities ln_isfcav = '//TRIM(fct_str(td_nam%l_isfcav))) 752 CALL logger_info(' vertical scale factors ln_e3_dep = '//TRIM(fct_str(td_nam%l_e3_dep))) 745 753 746 754 il_count=0 … … 759 767 ENDIF 760 768 769 IF(.NOT. td_nam%l_e3_dep )THEN 770 CALL logger_info("Obsolescent definition of e3 scale factors is used") 771 ENDIF 761 772 ! Build the vertical coordinate system 762 773 ! ------------------------------------ … … 773 784 ! z-coordinate 774 785 IF( td_nam%l_zco ) CALL grid_zgr__zco(jpk) 775 786 776 787 ! Partial step z-coordinate 777 788 IF( td_nam%l_zps ) CALL grid_zgr__zps_fill( td_nam,jpi,jpj,jpk,td_bathy,td_risfdep ) 778 789 779 790 ! s-coordinate or hybrid z-s coordinate 780 791 IF( td_nam%l_sco ) CALL grid_zgr__sco_fill( td_nam,jpi,jpj,jpk,td_bathy ) … … 807 818 !& ' 3w '//TRIM(fct_str(MINVAL( tg_gdep3w_0%d_value(:,:,:,1) )))//& 808 819 & ' t '//TRIM(fct_str(MINVAL( tg_e3t_0%d_value(:,:,:,1) )))//& 809 !& ' f '//TRIM(fct_str(MINVAL( tg_e3f_0%d_value(:,:,:,1) )))//&820 & ' f '//TRIM(fct_str(MINVAL( tg_e3f_0%d_value(:,:,:,1) )))//& 810 821 & ' u '//TRIM(fct_str(MINVAL( tg_e3u_0%d_value(:,:,:,1) )))//& 811 822 & ' v '//TRIM(fct_str(MINVAL( tg_e3v_0%d_value(:,:,:,1) )))//& 812 !& ' uw '//TRIM(fct_str(MINVAL( tg_e3uw_0%d_value(:,:,:,1) )))//&813 !& ' vw '//TRIM(fct_str(MINVAL( tg_e3vw_0%d_value(:,:,:,1) )))//&823 & ' uw '//TRIM(fct_str(MINVAL( tg_e3uw_0%d_value(:,:,:,1) )))//& 824 & ' vw '//TRIM(fct_str(MINVAL( tg_e3vw_0%d_value(:,:,:,1) )))//& 814 825 & ' w '//TRIM(fct_str(MINVAL( tg_e3w_0%d_value(:,:,:,1) ))) ) 815 826 CALL logger_info(' MAX val depth t '//TRIM(fct_str(MAXVAL( tg_gdept_0%d_value(:,:,:,1) )))//& … … 817 828 !& ' 3w '//TRIM(fct_str(MAXVAL( tg_gdep3w_0%d_value(:,:,:,1) ))) ) 818 829 CALL logger_info(' MAX val e3 t '//TRIM(fct_str(MAXVAL( tg_e3t_0%d_value(:,:,:,1) )))//& 819 !& ' f '//TRIM(fct_str(MAXVAL( tg_e3f_0%d_value(:,:,:,1) )))//&830 & ' f '//TRIM(fct_str(MAXVAL( tg_e3f_0%d_value(:,:,:,1) )))//& 820 831 & ' u '//TRIM(fct_str(MAXVAL( tg_e3u_0%d_value(:,:,:,1) )))//& 821 832 & ' v '//TRIM(fct_str(MAXVAL( tg_e3v_0%d_value(:,:,:,1) )))//& 822 !& ' uw '//TRIM(fct_str(MAXVAL( tg_e3uw_0%d_value(:,:,:,1) )))//&823 !& ' vw '//TRIM(fct_str(MAXVAL( tg_e3vw_0%d_value(:,:,:,1) )))//&833 & ' uw '//TRIM(fct_str(MAXVAL( tg_e3uw_0%d_value(:,:,:,1) )))//& 834 & ' vw '//TRIM(fct_str(MAXVAL( tg_e3vw_0%d_value(:,:,:,1) )))//& 824 835 & ' w '//TRIM(fct_str(MAXVAL( tg_e3w_0%d_value(:,:,:,1) ))) ) 825 836 … … 889 900 & td_nam%d_ppsur == dp_pp_to_be_computed ) THEN 890 901 ! 891 za1 = ( zdzmin - zhmax / FLOAT(jpk-1) )&892 & / ( TANH((1-zkth)/zacr) - zacr/ FLOAT(jpk-1) * ( LOG( COSH( (jpk - zkth) / zacr) )&893 & - LOG( COSH( ( 1 - zkth) / zacr) ) ))902 za1 = ( zdzmin - zhmax / REAL(jpk-1,dp) ) & 903 & / ( TANH((1-zkth)/zacr) - zacr/REAL(jpk-1,dp) * ( LOG( COSH( (jpk - zkth) / zacr) ) & 904 & - LOG( COSH( ( 1 - zkth) / zacr) ) ) ) 894 905 za0 = zdzmin - za1 * TANH( (1-zkth) / zacr ) 895 906 zsur = - za0 - za1 * zacr * LOG( COSH( (1-zkth) / zacr ) ) … … 904 915 CALL logger_info(' GRID ZGR Z : Reference vertical z-coordinates') 905 916 CALL logger_info('~~~~~~~~~~~') 906 IF( zkth == 0._ wp ) THEN917 IF( zkth == 0._dp ) THEN 907 918 CALL logger_info('Uniform grid with '//TRIM(fct_str(jpk-1))//' layers') 908 919 CALL logger_info('Total depth :'//TRIM(fct_str(zhmax))) 909 920 CALL logger_info('Layer thickness:'//TRIM(fct_str(zhmax/(jpk-1)))) 910 921 ELSE 911 IF( za1 == 0._ wp .AND. za0 == 0._wp .AND. zsur == 0._wp ) THEN922 IF( za1 == 0._dp .AND. za0 == 0._dp .AND. zsur == 0._dp ) THEN 912 923 CALL logger_info('zsur, za0, za1 computed from ') 913 924 CALL logger_info(' zdzmin = '//TRIM(fct_str(zdzmin))) … … 931 942 ! init 932 943 IF( zkth == 0._dp ) THEN ! uniform vertical grid 933 za1 = zhmax / FLOAT(jpk-1)944 za1 = zhmax / REAL(jpk-1,dp) 934 945 DO jk = 1, jpk 935 zw = FLOAT( jk)936 zt = FLOAT( jk) + 0.5_dp946 zw = REAL( jk, dp ) 947 zt = REAL( jk, dp ) + 0.5_dp 937 948 tg_gdepw_1d%d_value(1,1,jk,1) = ( zw - 1 ) * za1 938 949 tg_gdept_1d%d_value(1,1,jk,1) = ( zt - 1 ) * za1 … … 943 954 IF( .NOT. td_nam%l_dbletanh ) THEN 944 955 DO jk = 1, jpk 945 zw = REAL( jk , wp )946 zt = REAL( jk , wp ) + 0.5_dp956 zw = REAL( jk , dp ) 957 zt = REAL( jk , dp ) + 0.5_dp 947 958 tg_gdepw_1d%d_value(1,1,jk,1) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) ) ) 948 959 tg_gdept_1d%d_value(1,1,jk,1) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) ) ) … … 952 963 ELSE 953 964 DO jk = 1, jpk 954 zw = FLOAT( jk)955 zt = FLOAT( jk) + 0.5_dp965 zw = REAL( jk, dp ) 966 zt = REAL( jk, dp ) + 0.5_dp 956 967 ! Double tanh function 957 968 tg_gdepw_1d%d_value(1,1,jk,1) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr ) ) & … … 968 979 ENDIF 969 980 970 IF ( td_nam%l_isfcav ) THEN981 IF ( td_nam%l_isfcav .OR. td_nam%l_e3_dep ) THEN 971 982 ! need to be like this to compute the pressure gradient with ISF. 972 983 ! If not, level beneath the ISF are not aligned (sum(e3t) /= depth) … … 989 1000 ! 990 1001 ! ! ref. depth with tolerance (10% of minimum layer thickness) 991 ! zrefdep = 10._ wp - 0.1_wp * MINVAL( tg_e3w_1d%d_value(1,1,:,1) )1002 ! zrefdep = 10._dp - 0.1_dp * MINVAL( tg_e3w_1d%d_value(1,1,:,1) ) 992 1003 ! 993 1004 ! ! shallowest W level Below ~10m … … 1126 1137 WHERE ( td_bathy%d_value(:,:,1,1) <= td_risfdep%d_value(:,:,1,1) + td_nam%d_isfhmin ) 1127 1138 tg_misfdep%d_value(:,:,1,1) = 0 1128 td_risfdep%d_value(:,:,1,1) = 0._ wp1139 td_risfdep%d_value(:,:,1,1) = 0._dp 1129 1140 tg_mbathy%d_value (:,:,1,1) = 0 1130 td_bathy%d_value (:,:,1,1) = 0._ wp1141 td_bathy%d_value (:,:,1,1) = 0._dp 1131 1142 END WHERE 1132 1143 END IF … … 1211 1222 tg_e3u_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value (1,1,jk,1) 1212 1223 tg_e3v_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value (1,1,jk,1) 1213 !tg_e3f_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value (1,1,jk,1)1224 tg_e3f_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value (1,1,jk,1) 1214 1225 tg_e3w_0%d_value (:,:,jk,1) = tg_e3w_1d%d_value (1,1,jk,1) 1215 !tg_e3uw_0%d_value (:,:,jk,1) = tg_e3w_1d%d_value (1,1,jk,1)1216 !tg_e3vw_0%d_value (:,:,jk,1) = tg_e3w_1d%d_value (1,1,jk,1)1226 tg_e3uw_0%d_value (:,:,jk,1) = tg_e3w_1d%d_value (1,1,jk,1) 1227 tg_e3vw_0%d_value (:,:,jk,1) = tg_e3w_1d%d_value (1,1,jk,1) 1217 1228 END DO 1218 1229 … … 1760 1771 tg_gdept_0%d_value(ji,jj,ik+1,1) = tg_gdept_0%d_value(ji,jj,ik,1) + tg_e3t_0%d_value(ji,jj,ik,1) 1761 1772 ENDIF 1762 !gm Bug? check the gdepw_1d1763 ! ... on ik1764 tg_gdept_0%d_value(ji,jj,ik,1) = tg_gdepw_1d%d_value ( 1, 1,ik ,1) &1765 & + ( tg_gdepw_0%d_value (ji,jj,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) )&1766 & * ( (tg_gdept_1d%d_value( 1, 1,ik ,1) - tg_gdepw_1d%d_value(1,1,ik,1)) &1767 & / (tg_gdepw_1d%d_value( 1, 1,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1)) )1768 1769 tg_e3t_0%d_value (ji,jj,ik,1) = tg_e3t_1d%d_value ( 1, 1,ik ,1) &1770 & * ( tg_gdepw_0%d_value (ji,jj,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) ) &1771 & / ( tg_gdepw_1d%d_value( 1, 1,ik+1,1) - tg_gdepw_1d%d_value(1,1,ik,1) )1772 1773 tg_e3w_0%d_value (ji,jj,ik,1) = 0.5_dp &1774 & * ( tg_gdepw_0%d_value (ji,jj,ik+1,1) &1775 & + tg_gdepw_1d%d_value( 1, 1,ik+1,1) &1776 & - tg_gdepw_1d%d_value( 1, 1,ik ,1)*2._dp) &1777 & * ( tg_e3w_1d%d_value ( 1, 1,ik ,1) &1778 & / ( tg_gdepw_1d%d_value( 1, 1,ik+1,1) &1779 & - tg_gdepw_1d%d_value( 1, 1,ik ,1) ) )1780 1781 ! ... on ik+11782 tg_e3w_0%d_value (ji,jj,ik+1,1) = tg_e3t_0%d_value (ji,jj,ik,1)1783 tg_e3t_0%d_value (ji,jj,ik+1,1) = tg_e3t_0%d_value (ji,jj,ik,1)1784 tg_gdept_0%d_value(ji,jj,ik+1,1) = tg_gdept_0%d_value(ji,jj,ik,1) + tg_e3t_0%d_value(ji,jj,ik,1)1785 1773 ENDIF 1786 1774 END DO … … 1824 1812 tg_e3u_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1) 1825 1813 tg_e3v_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1) 1826 !tg_e3uw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1)1827 !tg_e3vw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1)1814 tg_e3uw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1) 1815 tg_e3vw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1) 1828 1816 END DO 1829 1817 … … 1834 1822 tg_e3u_0%d_value (ji,jj,jk,1) = MIN( tg_e3t_0%d_value(ji,jj,jk,1), tg_e3t_0%d_value(ji+1,jj ,jk,1) ) 1835 1823 tg_e3v_0%d_value (ji,jj,jk,1) = MIN( tg_e3t_0%d_value(ji,jj,jk,1), tg_e3t_0%d_value(ji ,jj+1,jk,1) ) 1836 !tg_e3uw_0%d_value(ji,jj,jk,1) = MIN( tg_e3w_0%d_value(ji,jj,jk,1), tg_e3w_0%d_value(ji+1,jj ,jk,1) )1837 !tg_e3vw_0%d_value(ji,jj,jk,1) = MIN( tg_e3w_0%d_value(ji,jj,jk,1), tg_e3w_0%d_value(ji ,jj+1,jk,1) )1824 tg_e3uw_0%d_value(ji,jj,jk,1) = MIN( tg_e3w_0%d_value(ji,jj,jk,1), tg_e3w_0%d_value(ji+1,jj ,jk,1) ) 1825 tg_e3vw_0%d_value(ji,jj,jk,1) = MIN( tg_e3w_0%d_value(ji,jj,jk,1), tg_e3w_0%d_value(ji ,jj+1,jk,1) ) 1838 1826 END DO 1839 1827 END DO 1840 1828 END DO 1841 1829 1842 !IF ( td_nam%l_isfcav ) THEN1843 !! (ISF) define e3uw (adapted for 2 cells in the water column)1844 !CALL grid_zgr__isf_fill_e3uw(jpi,jpj)1845 !END IF1830 IF ( td_nam%l_isfcav ) THEN 1831 ! (ISF) define e3uw (adapted for 2 cells in the water column) 1832 CALL grid_zgr__isf_fill_e3uw(jpi,jpj) 1833 END IF 1846 1834 1847 1835 ! lateral boundary conditions 1848 1836 CALL lbc_lnk( tg_e3u_0%d_value (:,:,:,1), 'U', td_nam%i_perio, 1._dp ) 1849 1837 CALL lbc_lnk( tg_e3v_0%d_value (:,:,:,1), 'V', td_nam%i_perio, 1._dp ) 1850 !CALL lbc_lnk( tg_e3uw_0%d_value(:,:,:,1), 'U', td_nam%i_perio, 1._dp )1851 !CALL lbc_lnk( tg_e3vw_0%d_value(:,:,:,1), 'V', td_nam%i_perio, 1._dp )1838 CALL lbc_lnk( tg_e3uw_0%d_value(:,:,:,1), 'U', td_nam%i_perio, 1._dp ) 1839 CALL lbc_lnk( tg_e3vw_0%d_value(:,:,:,1), 'V', td_nam%i_perio, 1._dp ) 1852 1840 1853 1841 ! set to z-scale factor if zero (i.e. along closed boundaries) … … 1855 1843 WHERE( tg_e3u_0%d_value (:,:,jk,1) == 0._dp ) tg_e3u_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1) 1856 1844 WHERE( tg_e3v_0%d_value (:,:,jk,1) == 0._dp ) tg_e3v_0%d_value (:,:,jk,1) = tg_e3t_1d%d_value(1,1,jk,1) 1857 !WHERE( tg_e3uw_0%d_value(:,:,jk,1) == 0._dp ) tg_e3uw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1)1858 !WHERE( tg_e3vw_0%d_value(:,:,jk,1) == 0._dp ) tg_e3vw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1)1845 WHERE( tg_e3uw_0%d_value(:,:,jk,1) == 0._dp ) tg_e3uw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1) 1846 WHERE( tg_e3vw_0%d_value(:,:,jk,1) == 0._dp ) tg_e3vw_0%d_value(:,:,jk,1) = tg_e3w_1d%d_value(1,1,jk,1) 1859 1847 END DO 1860 1848 … … 2000 1988 2001 1989 ! remove very shallow ice shelf (less than ~ 10m if 75L) 2002 WHERE( td_risfdep%d_value(:,:,1,1) <= 10._ wp .AND. &1990 WHERE( td_risfdep%d_value(:,:,1,1) <= 10._dp .AND. & 2003 1991 & tg_misfdep%d_value(:,:,1,1) > 1 ) 2004 1992 tg_misfdep%d_value(:,:,1,1) = 0 2005 td_risfdep%d_value(:,:,1,1) = 0.0_ wp1993 td_risfdep%d_value(:,:,1,1) = 0.0_dp 2006 1994 tg_mbathy%d_value (:,:,1,1) = 0 2007 td_bathy%d_value (:,:,1,1) = 0.0_ wp1995 td_bathy%d_value (:,:,1,1) = 0.0_dp 2008 1996 END WHERE 2009 WHERE( td_bathy%d_value(:,:,1,1) <= 30.0_ wp .AND. &2010 & tg_gphit%d_value(:,:,1,1) < -60._ wp )1997 WHERE( td_bathy%d_value(:,:,1,1) <= 30.0_dp .AND. & 1998 & tg_gphit%d_value(:,:,1,1) < -60._dp ) 2011 1999 tg_misfdep%d_value(:,:,1,1) = 0 2012 td_risfdep%d_value(:,:,1,1) = 0.0_ wp2000 td_risfdep%d_value(:,:,1,1) = 0.0_dp 2013 2001 tg_mbathy%d_value (:,:,1,1) = 0 2014 td_bathy%d_value (:,:,1,1) = 0.0_ wp2002 td_bathy%d_value (:,:,1,1) = 0.0_dp 2015 2003 END WHERE 2016 2004 … … 2669 2657 zdepwp = td_bathy%d_value(ji,jj,1,1) 2670 2658 ze3tp = td_bathy%d_value(ji,jj,1,1) - tg_gdepw_1d%d_value(1,1,ik,1) 2671 ze3wp = 0.5_ wp * tg_e3w_1d%d_value(1,1,ik,1) &2672 & * ( 1._ wp + ( ze3tp/tg_e3t_1d%d_value(1,1,ik,1) ) )2659 ze3wp = 0.5_dp * tg_e3w_1d%d_value(1,1,ik,1) & 2660 & * ( 1._dp + ( ze3tp/tg_e3t_1d%d_value(1,1,ik,1) ) ) 2673 2661 tg_e3t_0%d_value (ji,jj,ik ,1) = ze3tp 2674 2662 tg_e3t_0%d_value (ji,jj,ik+1,1) = ze3tp … … 2895 2883 ! 2896 2884 ! END SUBROUTINE grid_zgr__isf_fill_e3x 2897 !!-------------------------------------------------------------------2898 !!> @brief This subroutine define e3uw2899 !!> (adapted for 2 cells in the water column) for ISF case2900 !!>2901 !!> @details2902 !!>2903 !!> @author J.Paul2904 !!> @date September, 2015 - rewrite from zgr_zps2905 !!>2906 !!> @param[in] jpi2907 !!> @param[in] jpj2908 !!-------------------------------------------------------------------2909 !SUBROUTINE grid_zgr__isf_fill_e3uw(jpi,jpj)2910 !IMPLICIT NONE2911 !! Argument2912 !INTEGER(i4) , INTENT(IN ) :: jpi2913 !INTEGER(i4) , INTENT(IN ) :: jpj2914 ! 2915 !! local variable2916 !INTEGER(i4) :: ikb, ikt2917 ! 2918 !! loop indices2919 !INTEGER(i4) :: ji2920 !INTEGER(i4) :: jj2921 !!----------------------------------------------------------------2922 ! 2923 !DO jj = 2, jpj - 12924 !DO ji = 2, jpi - 12925 ! 2926 !ikb = MAX(tg_mbathy%d_value (ji,jj,1,1), tg_mbathy%d_value (ji+1,jj,1,1))2927 !ikt = MAX(tg_misfdep%d_value(ji,jj,1,1), tg_misfdep%d_value(ji+1,jj,1,1))2928 !IF( ikb == ikt+1 )THEN2929 !tg_e3uw_0%d_value(ji,jj,ikb,1) = MIN( tg_gdept_0%d_value(ji,jj,ikb ,1), tg_gdept_0%d_value(ji+1,jj ,ikb ,1) ) - &2930 !& MAX( tg_gdept_0%d_value(ji,jj,ikb-1,1), tg_gdept_0%d_value(ji+1,jj ,ikb-1,1) )2931 !ENDIF2932 !2933 !ikb = MAX( tg_mbathy%d_value (ji,jj,1,1), tg_mbathy%d_value (ji,jj+1,1,1))2934 !ikt = MAX( tg_misfdep%d_value(ji,jj,1,1), tg_misfdep%d_value(ji,jj+1,1,1))2935 !IF( ikb == ikt+1 )THEN2936 !tg_e3vw_0%d_value(ji,jj,ikb,1) = MIN( tg_gdept_0%d_value(ji,jj,ikb ,1), tg_gdept_0%d_value(ji ,jj+1,ikb ,1) ) - &2937 !& MAX( tg_gdept_0%d_value(ji,jj,ikb-1,1), tg_gdept_0%d_value(ji ,jj+1,ikb-1,1) )2938 !ENDIF2939 !END DO2940 !END DO2941 ! 2942 !END SUBROUTINE grid_zgr__isf_fill_e3uw2885 !------------------------------------------------------------------- 2886 !> @brief This subroutine define e3uw 2887 !> (adapted for 2 cells in the water column) for ISF case 2888 !> 2889 !> @details 2890 !> 2891 !> @author J.Paul 2892 !> @date September, 2015 - rewrite from zgr_zps 2893 !> 2894 !> @param[in] jpi 2895 !> @param[in] jpj 2896 !------------------------------------------------------------------- 2897 SUBROUTINE grid_zgr__isf_fill_e3uw(jpi,jpj) 2898 IMPLICIT NONE 2899 ! Argument 2900 INTEGER(i4) , INTENT(IN ) :: jpi 2901 INTEGER(i4) , INTENT(IN ) :: jpj 2902 2903 ! local variable 2904 INTEGER(i4) :: ikb, ikt 2905 2906 ! loop indices 2907 INTEGER(i4) :: ji 2908 INTEGER(i4) :: jj 2909 !---------------------------------------------------------------- 2910 2911 DO jj = 2, jpj - 1 2912 DO ji = 2, jpi - 1 2913 2914 ikb = MAX(tg_mbathy%d_value (ji,jj,1,1), tg_mbathy%d_value (ji+1,jj,1,1)) 2915 ikt = MAX(tg_misfdep%d_value(ji,jj,1,1), tg_misfdep%d_value(ji+1,jj,1,1)) 2916 IF( ikb == ikt+1 )THEN 2917 tg_e3uw_0%d_value(ji,jj,ikb,1) = MIN( tg_gdept_0%d_value(ji,jj,ikb ,1), tg_gdept_0%d_value(ji+1,jj ,ikb ,1) ) - & 2918 & MAX( tg_gdept_0%d_value(ji,jj,ikb-1,1), tg_gdept_0%d_value(ji+1,jj ,ikb-1,1) ) 2919 ENDIF 2920 2921 ikb = MAX( tg_mbathy%d_value (ji,jj,1,1), tg_mbathy%d_value (ji,jj+1,1,1)) 2922 ikt = MAX( tg_misfdep%d_value(ji,jj,1,1), tg_misfdep%d_value(ji,jj+1,1,1)) 2923 IF( ikb == ikt+1 )THEN 2924 tg_e3vw_0%d_value(ji,jj,ikb,1) = MIN( tg_gdept_0%d_value(ji,jj,ikb ,1), tg_gdept_0%d_value(ji ,jj+1,ikb ,1) ) - & 2925 & MAX( tg_gdept_0%d_value(ji,jj,ikb-1,1), tg_gdept_0%d_value(ji ,jj+1,ikb-1,1) ) 2926 ENDIF 2927 END DO 2928 END DO 2929 2930 END SUBROUTINE grid_zgr__isf_fill_e3uw 2943 2931 ! !------------------------------------------------------------------- 2944 2932 ! !> @brief This subroutine compute gdep3w_0 (vertical sum of e3w) … … 3012 3000 INTEGER(i4), INTENT(IN) :: jpi 3013 3001 INTEGER(i4), INTENT(IN) :: jpj 3014 ! LOGICAL , INTENT(IN) :: ld_domcfg3015 3002 3016 3003 ! local variable … … 3122 3109 REAL(dp), DIMENSION(:,:), ALLOCATABLE :: zrj 3123 3110 REAL(dp), DIMENSION(:,:), ALLOCATABLE :: zhbat 3124 REAL( wp), DIMENSION(:,:), ALLOCATABLE :: ztmpi13125 REAL( wp), DIMENSION(:,:), ALLOCATABLE :: ztmpi23126 REAL( wp), DIMENSION(:,:), ALLOCATABLE :: ztmpj13127 REAL( wp), DIMENSION(:,:), ALLOCATABLE :: ztmpj23111 REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ztmpi1 3112 REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ztmpi2 3113 REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ztmpj1 3114 REAL(dp), DIMENSION(:,:), ALLOCATABLE :: ztmpj2 3128 3115 3129 3116 ! loop indices … … 3170 3157 ! set maximum ocean depth 3171 3158 td_bathy%d_value(:,:,1,1) = MIN( td_nam%d_sbot_max, td_bathy%d_value(:,:,1,1) ) 3172 IF( .NOT. td_nam%l_wd )THEN3159 IF( .NOT. td_nam%l_wd )THEN 3173 3160 DO jj = 1, jpj 3174 3161 DO ji = 1, jpi … … 3187 3174 zenv(:,:) = td_bathy%d_value(:,:,1,1) 3188 3175 3189 IF( .NOT. td_nam%l_wd ) 3176 IF( .NOT. td_nam%l_wd )THEN 3190 3177 ! set first land point adjacent to a wet cell to sbot_min as this needs to be included in smoothing 3191 3178 DO jj = 1, jpj 3192 3179 DO ji = 1, jpi 3193 IF( td_bathy%d_value(ji,jj,1,1) == 0._dp ) 3180 IF( td_bathy%d_value(ji,jj,1,1) == 0._dp )THEN 3194 3181 iip1 = MIN( ji+1, jpi ) 3195 3182 ijp1 = MIN( jj+1, jpj ) … … 3203 3190 & td_bathy%d_value(iim1,ijm1,1,1) + & 3204 3191 & td_bathy%d_value(ji ,ijm1,1,1) + & 3205 & td_bathy%d_value(iip1,ijp1,1,1) ) > 0._dp ) 3192 & td_bathy%d_value(iip1,ijp1,1,1) ) > 0._dp )THEN 3206 3193 zenv(ji,jj) = td_nam%d_sbot_min 3207 3194 ENDIF … … 3212 3199 3213 3200 ! apply lateral boundary condition CAUTION: keep the value when the lbc field is zero 3214 CALL lbc_lnk( zenv(:,:), 'T', td_nam%i_perio, 1._dp) ! ?? , 'no0' ) 3201 ! this is only in mpp case, so here just do nothing 3202 !! CALL lbc_lnk( zenv(:,:), 'T', td_nam%i_perio, 1._dp, 'no0' ) 3215 3203 3216 3204 ! smooth the bathymetry (if required) … … 3226 3214 zrfact = ( 1._dp - td_nam%d_rmax ) / ( 1._dp + td_nam%d_rmax ) 3227 3215 3228 ! initialise temporary e velope depth arrays3216 ! initialise temporary envelope depth arrays 3229 3217 ALLOCATE(ztmpi1(jpi,jpj)) 3230 3218 ALLOCATE(ztmpi2(jpi,jpj)) … … 3236 3224 ztmpj1(:,:) = zenv(:,:) 3237 3225 ztmpj2(:,:) = zenv(:,:) 3238 3226 3239 3227 ! initialise temporary r-value arrays 3240 3228 ALLOCATE(zri(jpi,jpj)) … … 3266 3254 IF( (zenv(ji ,jj) > 0._dp) .AND. & 3267 3255 & (zenv(iip1,jj) > 0._dp) )THEN 3268 zri(ji,jj) = ( zenv(iip1, jj) - zenv(ji,jj) ) / ( zenv(iip1,jj) + zenv(ji,jj) )3256 zri(ji,jj) = ( zenv(iip1, jj) - zenv(ji,jj) ) / ( zenv(iip1,jj ) + zenv(ji,jj) ) 3269 3257 END IF 3270 3258 IF( (zenv(ji,jj ) > 0._dp) .AND. & 3271 3259 & (zenv(ji,ijp1) > 0._dp) )THEN 3272 zrj(ji,jj) = ( zenv(ji ,ijp1) - zenv(ji,jj) ) / ( zenv(ji,ijp1) + zenv(ji,jj) )3260 zrj(ji,jj) = ( zenv(ji ,ijp1) - zenv(ji,jj) ) / ( zenv(ji ,ijp1) + zenv(ji,jj) ) 3273 3261 END IF 3274 3262 IF( zri(ji,jj) > td_nam%d_rmax ) ztmpi1(ji ,jj ) = zenv(iip1,jj ) * zrfact … … 3293 3281 END DO 3294 3282 ! apply lateral boundary condition CAUTION: keep the value when the lbc field is zero 3295 CALL lbc_lnk( zenv, 'T', td_nam%i_perio, 1._dp) ! ?? , 'no0' ) 3283 ! this is only in mpp case, so here just do nothing 3284 !!CALL lbc_lnk( zenv, 'T', td_nam%i_perio, 1._dp, 'no0' ) 3296 3285 ENDDO 3297 3286 ! End loop ! … … 3345 3334 tg_hbatv%d_value(:,:,1,1) = td_nam%d_sbot_min 3346 3335 tg_hbatf%d_value(:,:,1,1) = td_nam%d_sbot_min 3347 3336 3348 3337 DO jj = 1, jpj-1 3349 3338 DO ji = 1, jpi-1 ! NO vector opt. … … 3363 3352 DO ji = 1, jpi 3364 3353 IF( ABS(tg_hbatt%d_value(ji,jj,1,1)) < td_nam%d_wdmin1 )THEN 3365 tg_hbatt%d_value(ji,jj,1,1) = SIGN(1._ wp, tg_hbatt%d_value(ji,jj,1,1)) * td_nam%d_wdmin13354 tg_hbatt%d_value(ji,jj,1,1) = SIGN(1._dp, tg_hbatt%d_value(ji,jj,1,1)) * td_nam%d_wdmin1 3366 3355 ENDIF 3367 3356 IF( ABS(tg_hbatu%d_value(ji,jj,1,1)) < td_nam%d_wdmin1 )THEN 3368 tg_hbatu%d_value(ji,jj,1,1) = SIGN(1._ wp, tg_hbatu%d_value(ji,jj,1,1)) * td_nam%d_wdmin13357 tg_hbatu%d_value(ji,jj,1,1) = SIGN(1._dp, tg_hbatu%d_value(ji,jj,1,1)) * td_nam%d_wdmin1 3369 3358 ENDIF 3370 3359 IF( ABS(tg_hbatv%d_value(ji,jj,1,1)) < td_nam%d_wdmin1 )THEN 3371 tg_hbatv%d_value(ji,jj,1,1) = SIGN(1._ wp, tg_hbatv%d_value(ji,jj,1,1)) * td_nam%d_wdmin13360 tg_hbatv%d_value(ji,jj,1,1) = SIGN(1._dp, tg_hbatv%d_value(ji,jj,1,1)) * td_nam%d_wdmin1 3372 3361 ENDIF 3373 3362 IF( ABS(tg_hbatf%d_value(ji,jj,1,1)) < td_nam%d_wdmin1 )THEN 3374 tg_hbatf%d_value(ji,jj,1,1) = SIGN(1._ wp, tg_hbatf%d_value(ji,jj,1,1)) * td_nam%d_wdmin13363 tg_hbatf%d_value(ji,jj,1,1) = SIGN(1._dp, tg_hbatf%d_value(ji,jj,1,1)) * td_nam%d_wdmin1 3375 3364 ENDIF 3376 3365 END DO … … 3386 3375 DO jj = 1, jpj 3387 3376 DO ji = 1, jpi 3388 IF( tg_hbatu%d_value(ji,jj,1,1) == 0._dp ) 3377 IF( tg_hbatu%d_value(ji,jj,1,1) == 0._dp )THEN 3389 3378 !No worries about the following line when l_wd == .true. 3390 3379 IF( zhbat(ji,jj) == 0._dp ) tg_hbatu%d_value(ji,jj,1,1) = td_nam%d_sbot_min … … 3419 3408 3420 3409 !!bug: key_helsinki a verifer 3421 IF( .NOT.td_nam%l_wd ) 3410 IF( .NOT.td_nam%l_wd )THEN 3422 3411 dl_hift(:,:) = MIN( dl_hift(:,:), tg_hbatt%d_value(:,:,1,1) ) 3423 3412 dl_hifu(:,:) = MIN( dl_hifu(:,:), tg_hbatu%d_value(:,:,1,1) ) 3424 3413 dl_hifv(:,:) = MIN( dl_hifv(:,:), tg_hbatv%d_value(:,:,1,1) ) 3425 3414 dl_hiff(:,:) = MIN( dl_hiff(:,:), tg_hbatf%d_value(:,:,1,1) ) 3426 ENDI f3415 ENDIF 3427 3416 3428 3417 CALL logger_info(' MAX val hif t '//TRIM(fct_str(MAXVAL( dl_hift(:,:) )))//& … … 3464 3453 CALL grid_zgr__sco_s_tanh( td_nam,jpi,jpj,jpk, & 3465 3454 & dl_scosrf, & 3466 & dl_hift, dl_hifu, dl_hifv )!, dl_hiff )3455 & dl_hift, dl_hifu, dl_hifv, dl_hiff ) 3467 3456 ENDIF 3468 3457 … … 3477 3466 CALL lbc_lnk( tg_e3u_0%d_value(:,:,:,1) , 'U', td_nam%i_perio, 1._dp ) 3478 3467 CALL lbc_lnk( tg_e3v_0%d_value(:,:,:,1) , 'V', td_nam%i_perio, 1._dp ) 3479 !CALL lbc_lnk( tg_e3f_0%d_value(:,:,:,1) , 'F', td_nam%i_perio, 1._dp )3468 CALL lbc_lnk( tg_e3f_0%d_value(:,:,:,1) , 'F', td_nam%i_perio, 1._dp ) 3480 3469 CALL lbc_lnk( tg_e3w_0%d_value(:,:,:,1) , 'W', td_nam%i_perio, 1._dp ) 3481 !CALL lbc_lnk( tg_e3uw_0%d_value(:,:,:,1), 'U', td_nam%i_perio, 1._dp )3482 !CALL lbc_lnk( tg_e3vw_0%d_value(:,:,:,1), 'V', td_nam%i_perio, 1._dp )3470 CALL lbc_lnk( tg_e3uw_0%d_value(:,:,:,1), 'U', td_nam%i_perio, 1._dp ) 3471 CALL lbc_lnk( tg_e3vw_0%d_value(:,:,:,1), 'V', td_nam%i_perio, 1._dp ) 3483 3472 3484 3473 IF( .NOT. td_nam%l_wd ) THEN 3485 WHERE( tg_e3t_0%d_value(:,:,:,1) == 0_dp ) tg_e3t_0%d_value(:,:,:,1) = 1._dp3486 WHERE( tg_e3u_0%d_value(:,:,:,1) == 0_dp ) tg_e3u_0%d_value(:,:,:,1) = 1._dp3487 WHERE( tg_e3v_0%d_value(:,:,:,1) == 0_dp ) tg_e3v_0%d_value(:,:,:,1) = 1._dp3488 !WHERE( tg_e3f_0%d_value(:,:,:,1) ==0_dp ) tg_e3f_0%d_value(:,:,:,1) = 1._dp3489 WHERE( tg_e3w_0%d_value(:,:,:,1) == 0_dp ) tg_e3w_0%d_value(:,:,:,1) = 1._dp3490 !WHERE( tg_e3uw_0%d_value(:,:,:,1)==0_dp ) tg_e3uw_0%d_value(:,:,:,1)= 1._dp3491 !WHERE( tg_e3vw_0%d_value(:,:,:,1)==0_dp ) tg_e3vw_0%d_value(:,:,:,1)= 1._dp3474 WHERE( tg_e3t_0%d_value(:,:,:,1) == 0_dp ) tg_e3t_0%d_value(:,:,:,1) = 1._dp 3475 WHERE( tg_e3u_0%d_value(:,:,:,1) == 0_dp ) tg_e3u_0%d_value(:,:,:,1) = 1._dp 3476 WHERE( tg_e3v_0%d_value(:,:,:,1) == 0_dp ) tg_e3v_0%d_value(:,:,:,1) = 1._dp 3477 WHERE( tg_e3f_0%d_value(:,:,:,1) == 0_dp ) tg_e3f_0%d_value(:,:,:,1) = 1._dp 3478 WHERE( tg_e3w_0%d_value(:,:,:,1) == 0_dp ) tg_e3w_0%d_value(:,:,:,1) = 1._dp 3479 WHERE( tg_e3uw_0%d_value(:,:,:,1)== 0_dp ) tg_e3uw_0%d_value(:,:,:,1)= 1._dp 3480 WHERE( tg_e3vw_0%d_value(:,:,:,1)== 0_dp ) tg_e3vw_0%d_value(:,:,:,1)= 1._dp 3492 3481 ENDIF 3493 3482 … … 3529 3518 3530 3519 CALL logger_info(' MIN val e3 t '//TRIM(fct_str(MINVAL( tg_e3t_0%d_value(:,:,:,1) )))//& 3531 !& ' f '//TRIM(fct_str(MINVAL( tg_e3f_0%d_value(:,:,:,1) )))//&3520 & ' f '//TRIM(fct_str(MINVAL( tg_e3f_0%d_value(:,:,:,1) )))//& 3532 3521 & ' u '//TRIM(fct_str(MINVAL( tg_e3u_0%d_value(:,:,:,1) )))//& 3533 3522 & ' v '//TRIM(fct_str(MINVAL( tg_e3v_0%d_value(:,:,:,1) )))//& 3534 !& ' uw '//TRIM(fct_str(MINVAL( tg_e3uw_0%d_value(:,:,:,1) )))//&3535 !& ' vw '//TRIM(fct_str(MINVAL( tg_e3vw_0%d_value(:,:,:,1) )))//&3523 & ' uw '//TRIM(fct_str(MINVAL( tg_e3uw_0%d_value(:,:,:,1) )))//& 3524 & ' vw '//TRIM(fct_str(MINVAL( tg_e3vw_0%d_value(:,:,:,1) )))//& 3536 3525 & ' w '//TRIM(fct_str(MINVAL( tg_e3w_0%d_value(:,:,:,1) ))) ) 3537 3526 … … 3541 3530 3542 3531 CALL logger_info(' MAX val e3 t '//TRIM(fct_str(MAXVAL( tg_e3t_0%d_value(:,:,:,1) )))//& 3543 !& ' f '//TRIM(fct_str(MAXVAL( tg_e3f_0%d_value(:,:,:,1) )))//&3532 & ' f '//TRIM(fct_str(MAXVAL( tg_e3f_0%d_value(:,:,:,1) )))//& 3544 3533 & ' u '//TRIM(fct_str(MAXVAL( tg_e3u_0%d_value(:,:,:,1) )))//& 3545 3534 & ' v '//TRIM(fct_str(MAXVAL( tg_e3v_0%d_value(:,:,:,1) )))//& 3546 !& ' uw '//TRIM(fct_str(MAXVAL( tg_e3uw_0%d_value(:,:,:,1) )))//&3547 !& ' vw '//TRIM(fct_str(MAXVAL( tg_e3vw_0%d_value(:,:,:,1) )))//&3535 & ' uw '//TRIM(fct_str(MAXVAL( tg_e3uw_0%d_value(:,:,:,1) )))//& 3536 & ' vw '//TRIM(fct_str(MAXVAL( tg_e3vw_0%d_value(:,:,:,1) )))//& 3548 3537 & ' w '//TRIM(fct_str(MAXVAL( tg_e3w_0%d_value(:,:,:,1) ))) ) 3549 3538 … … 3554 3543 DO jj = 1, jpj 3555 3544 3556 IF( tg_hbatt%d_value(ji,jj,1,1) > 0._dp )THEN3545 IF( tg_hbatt%d_value(ji,jj,1,1) > 0._dp )THEN 3557 3546 DO jk = 1, INT(tg_mbathy%d_value(ji,jj,1,1),i4) 3558 3547 ! check coordinate is monotonically increasing … … 3596 3585 ENDIF 3597 3586 ENDDO 3598 3599 3587 ENDIF 3600 3588 … … 3637 3625 REAL(dp) :: zcoefw 3638 3626 3639 REAL( wp) :: ztmpu3640 REAL( wp) :: ztmpv3641 REAL( wp) :: ztmpf3642 REAL( wp) :: ztmpu13643 REAL( wp) :: ztmpv13644 REAL( wp) :: ztmpf13627 REAL(dp) :: ztmpu 3628 REAL(dp) :: ztmpv 3629 REAL(dp) :: ztmpf 3630 REAL(dp) :: ztmpu1 3631 REAL(dp) :: ztmpv1 3632 REAL(dp) :: ztmpf1 3645 3633 3646 3634 REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsigw3 … … 3747 3735 3748 3736 IF( td_nam%l_wd .AND. & 3749 & ( ztmpu1 < 0._ wp .OR. ABS(ztmpu) < td_nam%d_wdmin1 ) )THEN3750 z_esigtu3(ji,jj,jk) = 0.5_ wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) )3751 z_esigwu3(ji,jj,jk) = 0.5_ wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) )3737 & ( ztmpu1 < 0._dp .OR. ABS(ztmpu) < td_nam%d_wdmin1 ) )THEN 3738 z_esigtu3(ji,jj,jk) = 0.5_dp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) ) 3739 z_esigwu3(ji,jj,jk) = 0.5_dp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) ) 3752 3740 ELSE 3753 3741 z_esigtu3(ji,jj,jk) = ( tg_hbatt%d_value(ji ,jj,1,1)*z_esigt3(ji ,jj,jk) & … … 3758 3746 3759 3747 IF( td_nam%l_wd .AND. & 3760 & ( ztmpv1 < 0._ wp .OR. ABS(ztmpv) < td_nam%d_wdmin1 ) )THEN3761 z_esigtv3(ji,jj,jk) = 0.5_ wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) )3762 z_esigwv3(ji,jj,jk) = 0.5_ wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) )3748 & ( ztmpv1 < 0._dp .OR. ABS(ztmpv) < td_nam%d_wdmin1 ) )THEN 3749 z_esigtv3(ji,jj,jk) = 0.5_dp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) ) 3750 z_esigwv3(ji,jj,jk) = 0.5_dp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) ) 3763 3751 ELSE 3764 3752 z_esigtv3(ji,jj,jk) = ( tg_hbatt%d_value(ji,jj ,1,1)*z_esigt3(ji,jj ,jk) & … … 3769 3757 3770 3758 IF( td_nam%l_wd .AND. & 3771 & ( ztmpf1 < 0._ wp .OR. ABS(ztmpf) < td_nam%d_wdmin1 ) )THEN3772 z_esigtf3(ji,jj,jk) = 0.25_ wp * ( z_esigt3(ji ,jj ,jk) &3759 & ( ztmpf1 < 0._dp .OR. ABS(ztmpf) < td_nam%d_wdmin1 ) )THEN 3760 z_esigtf3(ji,jj,jk) = 0.25_dp * ( z_esigt3(ji ,jj ,jk) & 3773 3761 & + z_esigt3(ji+1,jj ,jk) & 3774 3762 & + z_esigt3(ji ,jj+1,jk) & … … 3787 3775 tg_e3v_0%d_value(ji,jj,jk,1) = ( ( tg_hbatv%d_value(ji,jj,1,1) - td_nam%d_hc )*z_esigtv3(ji,jj,jk) & 3788 3776 & + td_nam%d_hc / REAL(jpk-1,dp) ) 3789 !tg_e3f_0%d_value(ji,jj,jk,1) = ( ( tg_hbatf%d_value(ji,jj,1,1) - td_nam%d_hc ) *z_esigtf3(ji,jj,jk) &3790 !& + td_nam%d_hc/REAL(jpk-1,dp) )3791 !3777 tg_e3f_0%d_value(ji,jj,jk,1) = ( ( tg_hbatf%d_value(ji,jj,1,1) - td_nam%d_hc ) *z_esigtf3(ji,jj,jk) & 3778 & + td_nam%d_hc/REAL(jpk-1,dp) ) 3779 3792 3780 tg_e3w_0%d_value (ji,jj,jk,1)= ( ( tg_hbatt%d_value(ji,jj,1,1) - td_nam%d_hc )*z_esigw3 (ji,jj,jk) & 3793 3781 & + td_nam%d_hc / REAL(jpk-1,dp) ) 3794 !tg_e3uw_0%d_value(ji,jj,jk,1)= ( ( tg_hbatu%d_value(ji,jj,1,1) - td_nam%d_hc)*z_esigwu3(ji,jj,jk) &3795 !& + td_nam%d_hc/REAL(jpk-1,dp) )3796 !tg_e3vw_0%d_value(ji,jj,jk,1)= ( ( tg_hbatv%d_value(ji,jj,1,1) - td_nam%d_hc)*z_esigwv3(ji,jj,jk) &3797 !& + td_nam%d_hc/REAL(jpk-1,dp) )3782 tg_e3uw_0%d_value(ji,jj,jk,1)= ( ( tg_hbatu%d_value(ji,jj,1,1) - td_nam%d_hc)*z_esigwu3(ji,jj,jk) & 3783 & + td_nam%d_hc/REAL(jpk-1,dp) ) 3784 tg_e3vw_0%d_value(ji,jj,jk,1)= ( ( tg_hbatv%d_value(ji,jj,1,1) - td_nam%d_hc)*z_esigwv3(ji,jj,jk) & 3785 & + td_nam%d_hc/REAL(jpk-1,dp) ) 3798 3786 END DO 3799 3787 END DO … … 3850 3838 REAL(dp) :: zzs, zzb ! Surface and bottom cell thickness in sigma space 3851 3839 3852 REAL( wp) :: ztmpu3853 REAL( wp) :: ztmpv3854 REAL( wp) :: ztmpf3855 REAL( wp) :: ztmpu13856 REAL( wp) :: ztmpv13857 REAL( wp) :: ztmpf13840 REAL(dp) :: ztmpu 3841 REAL(dp) :: ztmpv 3842 REAL(dp) :: ztmpf 3843 REAL(dp) :: ztmpu1 3844 REAL(dp) :: ztmpv1 3845 REAL(dp) :: ztmpf1 3858 3846 3859 3847 REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: z_gsigw3 … … 3909 3897 3910 3898 IF( td_nam%d_efold /= 0.0_dp )THEN 3911 zsmth = tanh( (tg_hbatt%d_value(ji,jj,1,1)-td_nam%d_hc ) / td_nam%d_efold )3899 zsmth = TANH( (tg_hbatt%d_value(ji,jj,1,1)-td_nam%d_hc ) / td_nam%d_efold ) 3912 3900 ELSE 3913 3901 zsmth = 1.0_dp … … 3932 3920 DO jk = 1, jpk 3933 3921 z_gsigw3(ji,jj,jk) = REAL(jk-1,dp) /REAL(jpk-1,dp)*(td_nam%d_hc/tg_hbatt%d_value(ji,jj,1,1)) 3934 z_gsigt3(ji,jj,jk) = (REAL(jk-1,dp)+0.5_ wp)/REAL(jpk-1,dp)*(td_nam%d_hc/tg_hbatt%d_value(ji,jj,1,1))3922 z_gsigt3(ji,jj,jk) = (REAL(jk-1,dp)+0.5_dp)/REAL(jpk-1,dp)*(td_nam%d_hc/tg_hbatt%d_value(ji,jj,1,1)) 3935 3923 END DO 3936 3924 … … 3951 3939 3952 3940 DO jk = 1, jpk 3953 tg_gdept_0%d_value 3954 tg_gdepw_0%d_value 3941 tg_gdept_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatt%d_value(ji,jj,1,1))*z_gsigt3(ji,jj,jk) 3942 tg_gdepw_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatt%d_value(ji,jj,1,1))*z_gsigw3(ji,jj,jk) 3955 3943 !tg_gdep3w_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatt%d_value(ji,jj,1,1))*z_gsi3w3(ji,jj,jk) 3956 3944 END DO … … 3978 3966 3979 3967 IF( td_nam%l_wd .AND. & 3980 & ( ztmpu1 < 0._ wp .OR. ABS(ztmpu) < td_nam%d_wdmin1 ) )THEN3981 z_esigtu3(ji,jj,jk) = 0.5_ wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) )3982 z_esigwu3(ji,jj,jk) = 0.5_ wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) )3968 & ( ztmpu1 < 0._dp .OR. ABS(ztmpu) < td_nam%d_wdmin1 ) )THEN 3969 z_esigtu3(ji,jj,jk) = 0.5_dp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji+1,jj,jk) ) 3970 z_esigwu3(ji,jj,jk) = 0.5_dp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji+1,jj,jk) ) 3983 3971 ELSE 3984 3972 z_esigtu3(ji,jj,jk) = ( tg_hbatt%d_value(ji ,jj,1,1)*z_esigt3(ji ,jj,jk) & 3985 & + tg_hbatt%d_value(ji+1,jj,1,1)*z_esigt3(ji+1,jj,jk) ) / ztmpu3973 & + tg_hbatt%d_value(ji+1,jj,1,1)*z_esigt3(ji+1,jj,jk) ) / ztmpu 3986 3974 z_esigwu3(ji,jj,jk) = ( tg_hbatt%d_value(ji ,jj,1,1)*z_esigw3(ji ,jj,jk) & 3987 & + tg_hbatt%d_value(ji+1,jj,1,1)*z_esigw3(ji+1,jj,jk) ) / ztmpu3975 & + tg_hbatt%d_value(ji+1,jj,1,1)*z_esigw3(ji+1,jj,jk) ) / ztmpu 3988 3976 ENDIF 3989 3977 3990 3978 IF( td_nam%l_wd .AND. & 3991 & ( ztmpv1 < 0._ wp .OR. ABS(ztmpv) < td_nam%d_wdmin1 ) )THEN3992 z_esigtv3(ji,jj,jk) = 0.5_ wp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) )3993 z_esigwv3(ji,jj,jk) = 0.5_ wp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) )3979 & ( ztmpv1 < 0._dp .OR. ABS(ztmpv) < td_nam%d_wdmin1 ) )THEN 3980 z_esigtv3(ji,jj,jk) = 0.5_dp * ( z_esigt3(ji,jj,jk) + z_esigt3(ji,jj+1,jk) ) 3981 z_esigwv3(ji,jj,jk) = 0.5_dp * ( z_esigw3(ji,jj,jk) + z_esigw3(ji,jj+1,jk) ) 3994 3982 ELSE 3995 3983 z_esigtv3(ji,jj,jk) = ( tg_hbatt%d_value(ji,jj ,1,1)*z_esigt3(ji,jj ,jk) & … … 4000 3988 4001 3989 IF( td_nam%l_wd .AND. & 4002 & ( ztmpf1 < 0._ wp .OR. ABS(ztmpf) < td_nam%d_wdmin1 ) )THEN4003 z_esigtf3(ji,jj,jk) = 0.25_ wp * ( z_esigt3(ji ,jj ,jk) &3990 & ( ztmpf1 < 0._dp .OR. ABS(ztmpf) < td_nam%d_wdmin1 ) )THEN 3991 z_esigtf3(ji,jj,jk) = 0.25_dp * ( z_esigt3(ji ,jj ,jk) & 4004 3992 & + z_esigt3(ji+1,jj ,jk) & 4005 3993 & + z_esigt3(ji ,jj+1,jk) & … … 4015 4003 tg_e3u_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatu%d_value(ji,jj,1,1))*z_esigtu3(ji,jj,jk) 4016 4004 tg_e3v_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatv%d_value(ji,jj,1,1))*z_esigtv3(ji,jj,jk) 4017 !tg_e3f_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatf%d_value(ji,jj,1,1))*z_esigtf3(ji,jj,jk)4005 tg_e3f_0%d_value(ji,jj,jk,1) = (dd_scosrf(ji,jj)+tg_hbatf%d_value(ji,jj,1,1))*z_esigtf3(ji,jj,jk) 4018 4006 ! 4019 tg_e3w_0%d_value (ji,jj,jk,1)= tg_hbatt%d_value(ji,jj,1,1)*z_esigw3 (ji,jj,jk)4020 !tg_e3uw_0%d_value(ji,jj,jk,1) = tg_hbatu%d_value(ji,jj,1,1)*z_esigwu3(ji,jj,jk)4021 !tg_e3vw_0%d_value(ji,jj,jk,1) = tg_hbatv%d_value(ji,jj,1,1)*z_esigwv3(ji,jj,jk)4007 tg_e3w_0%d_value(ji,jj,jk,1) = tg_hbatt%d_value(ji,jj,1,1)*z_esigw3 (ji,jj,jk) 4008 tg_e3uw_0%d_value(ji,jj,jk,1) = tg_hbatu%d_value(ji,jj,1,1)*z_esigwu3(ji,jj,jk) 4009 tg_e3vw_0%d_value(ji,jj,jk,1) = tg_hbatv%d_value(ji,jj,1,1)*z_esigwv3(ji,jj,jk) 4022 4010 END DO 4023 4011 … … 4028 4016 CALL lbc_lnk(tg_e3u_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp) 4029 4017 CALL lbc_lnk(tg_e3v_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp) 4030 !CALL lbc_lnk(tg_e3f_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp)4018 CALL lbc_lnk(tg_e3f_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp) 4031 4019 CALL lbc_lnk(tg_e3w_0 %d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp) 4032 !CALL lbc_lnk(tg_e3uw_0%d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp)4033 !CALL lbc_lnk(tg_e3vw_0%d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp)4020 CALL lbc_lnk(tg_e3uw_0%d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp) 4021 CALL lbc_lnk(tg_e3vw_0%d_value(:,:,:,1),'T', td_nam%i_perio, 1._dp) 4034 4022 4035 4023 DEALLOCATE( z_gsigw3 ) … … 4068 4056 SUBROUTINE grid_zgr__sco_s_tanh( td_nam,jpi,jpj,jpk, & 4069 4057 & dd_scosrf, & 4070 & dd_hift, dd_hifu, dd_hifv )!, dd_hiff )4058 & dd_hift, dd_hifu, dd_hifv, dd_hiff ) 4071 4059 IMPLICIT NONE 4072 4060 ! Argument … … 4079 4067 REAL(dp) , DIMENSION(:,:), INTENT(IN ) :: dd_hifu 4080 4068 REAL(dp) , DIMENSION(:,:), INTENT(IN ) :: dd_hifv 4081 !REAL(dp) , DIMENSION(:,:), INTENT(IN ) :: dd_hiff4069 REAL(dp) , DIMENSION(:,:), INTENT(IN ) :: dd_hiff 4082 4070 4083 4071 ! local variable … … 4140 4128 tg_e3v_0%d_value(ji,jj,jk,1) = ( (tg_hbatv%d_value(ji,jj,1 ,1) - dd_hifv(ji,jj)) & 4141 4129 & * tg_esigt%d_value(1 ,1 ,jk,1) + dd_hifv(ji,jj)/REAL(jpk-1,dp) ) 4142 !tg_e3f_0%d_value(ji,jj,jk,1) = ( (tg_hbatf%d_value(ji,jj,1 ,1) - dd_hiff(ji,jj)) &4143 !& * tg_esigt%d_value(1 ,1, jk,1) + dd_hiff(ji,jj)/REAL(jpk-1,dp) )4130 tg_e3f_0%d_value(ji,jj,jk,1) = ( (tg_hbatf%d_value(ji,jj,1 ,1) - dd_hiff(ji,jj)) & 4131 & * tg_esigt%d_value(1 ,1, jk,1) + dd_hiff(ji,jj)/REAL(jpk-1,dp) ) 4144 4132 4145 4133 tg_e3w_0%d_value (ji,jj,jk,1)= ( (tg_hbatt%d_value(ji,jj,1 ,1) - dd_hift(ji,jj)) & 4146 4134 & * tg_esigw%d_value(1 ,1 ,jk,1) + dd_hift(ji,jj)/REAL(jpk-1,dp) ) 4147 !tg_e3uw_0%d_value(ji,jj,jk,1)= ( (tg_hbatu%d_value(ji,jj,1 ,1) - dd_hifu(ji,jj)) &4148 !& * tg_esigw%d_value(1 ,1 ,jk,1) + dd_hifu(ji,jj)/REAL(jpk-1,dp) )4149 !tg_e3vw_0%d_value(ji,jj,jk,1)= ( (tg_hbatv%d_value(ji,jj,1 ,1) - dd_hifv(ji,jj)) &4150 !& * tg_esigw%d_value(1 ,1 ,jk,1) + dd_hifv(ji,jj)/REAL(jpk-1,dp) )4135 tg_e3uw_0%d_value(ji,jj,jk,1)= ( (tg_hbatu%d_value(ji,jj,1 ,1) - dd_hifu(ji,jj)) & 4136 & * tg_esigw%d_value(1 ,1 ,jk,1) + dd_hifu(ji,jj)/REAL(jpk-1,dp) ) 4137 tg_e3vw_0%d_value(ji,jj,jk,1)= ( (tg_hbatv%d_value(ji,jj,1 ,1) - dd_hifv(ji,jj)) & 4138 & * tg_esigw%d_value(1 ,1 ,jk,1) + dd_hifv(ji,jj)/REAL(jpk-1,dp) ) 4151 4139 END DO 4152 4140 END DO … … 4179 4167 !!---------------------------------------------------------------------- 4180 4168 ! 4181 pf = ( TANH( td_nam%d_theta * ( -(pk-0.5_dp) / REAL(jpk-1 ) + td_nam%d_thetb ) )&4182 & - TANH( td_nam%d_thetb * td_nam%d_theta ) )&4183 & * ( COSH( td_nam%d_theta )&4184 & + COSH( td_nam%d_theta * ( 2._dp * td_nam%d_thetb - 1._dp ) ) ) &4169 pf = ( TANH( td_nam%d_theta * ( -(pk-0.5_dp) / REAL(jpk-1,dp) + td_nam%d_thetb ) ) & 4170 & - TANH( td_nam%d_thetb * td_nam%d_theta ) ) & 4171 & * ( COSH( td_nam%d_theta ) & 4172 & + COSH( td_nam%d_theta * ( 2._dp * td_nam%d_thetb - 1._dp ) ) ) & 4185 4173 & / ( 2._dp * SINH( td_nam%d_theta ) ) 4186 4174 ! … … 4215 4203 ! 4216 4204 IF ( td_nam%d_theta == 0 ) then ! uniform sigma 4217 pf1 = - ( pk1 - 0.5_dp ) / REAL( jpk-1)4205 pf1 = - ( pk1 - 0.5_dp ) / REAL(jpk-1,dp) 4218 4206 ELSE ! stretched sigma 4219 pf1 = ( 1._dp - pbb ) * ( SINH( td_nam%d_theta*(-(pk1-0.5_dp)/REAL(jpk-1 )) ) ) / SINH( td_nam%d_theta ) &4220 & + pbb * ( (TANH( td_nam%d_theta*( (-(pk1-0.5_dp)/REAL(jpk-1 )) + 0.5_dp) ) - TANH( 0.5_dp * td_nam%d_theta ) ) &4207 pf1 = ( 1._dp - pbb ) * ( SINH( td_nam%d_theta*(-(pk1-0.5_dp)/REAL(jpk-1,dp)) ) ) / SINH( td_nam%d_theta ) & 4208 & + pbb * ( (TANH( td_nam%d_theta*( (-(pk1-0.5_dp)/REAL(jpk-1,dp)) + 0.5_dp) ) - TANH( 0.5_dp * td_nam%d_theta ) ) & 4221 4209 & / ( 2._dp * TANH( 0.5_dp * td_nam%d_theta ) ) ) 4222 4210 ENDIF … … 4253 4241 TYPE(TNAMZ), INTENT(IN ) :: td_nam 4254 4242 INTEGER(i4), INTENT(IN ) :: jpk 4255 REAL(dp) , INTENT(IN ) :: pk1(jpk) ! continuous "k" coordinate 4256 REAL(dp) :: p_gamma(jpk) ! stretched coordinate 4243 REAL(dp) , DIMENSION(:) , INTENT(IN ) :: pk1 ! continuous "k" coordinate 4244 ! function 4245 REAL(dp) , DIMENSION(jpk) :: p_gamma ! stretched coordinate 4246 ! local variable 4257 4247 REAL(dp) , INTENT(IN ) :: pzb ! Bottom box depth 4258 4248 REAL(dp) , INTENT(IN ) :: pzs ! surface box depth … … 4266 4256 !!---------------------------------------------------------------------- 4267 4257 ! 4268 zn1 = 1. /(jpk-1.)4269 zn2 = 1. - zn14258 zn1 = 1._dp / REAL(jpk-1,dp) 4259 zn2 = 1._dp - zn1 4270 4260 4271 4261 za1 = (td_nam%d_alpha+2.0_dp)*zn1**(td_nam%d_alpha+1.0_dp)-(td_nam%d_alpha+1.0_dp)*zn1**(td_nam%d_alpha+2.0_dp) … … 4363 4353 & + tg_gdepw_0%d_value(ji ,jj ,jk+1,1)& 4364 4354 & - tg_gdepw_0%d_value(ji ,jj-1,jk+1,1) ) & 4365 & / ( tg_gdepw_0%d_value(ji ,jj ,jk ,1)&4355 & / ( tg_gdepw_0%d_value(ji ,jj ,jk ,1)& 4366 4356 & + tg_gdepw_0%d_value(ji ,jj-1,jk ,1)& 4367 4357 & - tg_gdepw_0%d_value(ji ,jj ,jk+1,1)&
Note: See TracChangeset
for help on using the changeset viewer.
