Changeset 2408 for LMDZ5/branches/testing/libf/phylmd/pbl_surface_mod.F90
- Timestamp:
- Dec 14, 2015, 11:43:09 AM (9 years ago)
- Location:
- LMDZ5/branches/testing
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/pbl_surface_mod.F90 (modified) (24 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/testing
- Property svn:mergeinfo changed
/LMDZ5/trunk merged: 2293-2295,2297,2299-2302,2305-2313,2315,2317-2380,2382-2396
- Property svn:mergeinfo changed
-
LMDZ5/branches/testing/libf/phylmd/pbl_surface_mod.F90
r2298 r2408 23 23 USE climb_wind_mod, ONLY : climb_wind_down, climb_wind_up 24 24 USE coef_diff_turb_mod, ONLY : coef_diff_turb 25 USE control_mod26 25 27 26 … … 49 48 50 49 USE indice_sol_mod 50 USE print_control_mod, ONLY: lunout 51 51 52 52 INCLUDE "dimsoil.h" 53 INCLUDE "iniprint.h"54 53 55 54 ! Input variables … … 73 72 !**************************************************************************************** 74 73 ALLOCATE(fder(klon), stat=ierr) 75 IF (ierr /= 0) CALL abort_ gcm('pbl_surface_init', 'pb in allocation',1)74 IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1) 76 75 77 76 ALLOCATE(snow(klon,nbsrf), stat=ierr) 78 IF (ierr /= 0) CALL abort_ gcm('pbl_surface_init', 'pb in allocation',1)77 IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1) 79 78 80 79 ALLOCATE(qsurf(klon,nbsrf), stat=ierr) 81 IF (ierr /= 0) CALL abort_ gcm('pbl_surface_init', 'pb in allocation',1)80 IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1) 82 81 83 82 ALLOCATE(ftsoil(klon,nsoilmx,nbsrf), stat=ierr) 84 IF (ierr /= 0) CALL abort_ gcm('pbl_surface_init', 'pb in allocation',1)83 IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1) 85 84 86 85 … … 100 99 WRITE(lunout,*)"or on doit commencer par les surfaces continentales" 101 100 abort_message="voir ci-dessus" 102 CALL abort_ gcm(modname,abort_message,1)101 CALL abort_physic(modname,abort_message,1) 103 102 ENDIF 104 103 … … 109 108 WRITE(lunout,*)' or is_oce = ',is_oce, '> is_sic = ',is_sic 110 109 abort_message='voir ci-dessus' 111 CALL abort_ gcm(modname,abort_message,1)110 CALL abort_physic(modname,abort_message,1) 112 111 ENDIF 113 112 … … 118 117 WRITE(lunout,*)' or is_lic = ',is_lic, '> is_sic = ',is_sic 119 118 abort_message='voir ci-dessus' 120 CALL abort_ gcm(modname,abort_message,1)119 CALL abort_physic(modname,abort_message,1) 121 120 ENDIF 122 121 … … 130 129 WRITE(lunout,*)'Option couplage pour l''ocean = ', type_ocean 131 130 abort_message='option pour l''ocean non valable' 132 CALL abort_ gcm(modname,abort_message,1)131 CALL abort_physic(modname,abort_message,1) 133 132 ENDIF 134 133 … … 261 260 USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send 262 261 USE indice_sol_mod 262 USE time_phylmdz_mod, ONLY: day_ini,annee_ref,itau_phy 263 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 264 USE print_control_mod, ONLY: prt_level,lunout 263 265 264 266 IMPLICIT NONE … … 266 268 INCLUDE "dimsoil.h" 267 269 INCLUDE "YOMCST.h" 268 INCLUDE "iniprint.h"269 270 INCLUDE "YOETHF.h" 270 271 INCLUDE "FCTTRE.h" 271 272 INCLUDE "clesphys.h" 272 273 INCLUDE "compbl.h" 273 INCLUDE "dimensions.h"274 INCLUDE "temps.h"275 274 INCLUDE "flux_arp.h" 276 275 !**************************************************************************************** … … 733 732 734 733 ! For debugging with IOIPSL 735 INTEGER, DIMENSION( iim*(jjm+1)) :: ndexbg734 INTEGER, DIMENSION(nbp_lon*nbp_lat) :: ndexbg 736 735 REAL :: zjulian 737 736 REAL, DIMENSION(klon) :: tabindx 738 REAL, DIMENSION( iim,jjm+1) :: zx_lon, zx_lat739 REAL, DIMENSION( iim,jjm+1) :: debugtab737 REAL, DIMENSION(nbp_lon,nbp_lat) :: zx_lon, zx_lat 738 REAL, DIMENSION(nbp_lon,nbp_lat) :: debugtab 740 739 741 740 … … 794 793 idayref = day_ini 795 794 CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) 796 CALL gr_fi_ecrit(1,klon, iim,jjm+1,rlon,zx_lon)797 DO i = 1, iim795 CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlon,zx_lon) 796 DO i = 1, nbp_lon 798 797 zx_lon(i,1) = rlon(i+1) 799 zx_lon(i, jjm+1) = rlon(i+1)798 zx_lon(i,nbp_lat) = rlon(i+1) 800 799 ENDDO 801 CALL gr_fi_ecrit(1,klon, iim,jjm+1,rlat,zx_lat)802 CALL histbeg("sous_index", iim,zx_lon(:,1),jjm+1,zx_lat(1,:), &803 1, iim,1,jjm+1, &800 CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlat,zx_lat) 801 CALL histbeg("sous_index",nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:), & 802 1,nbp_lon,1,nbp_lat, & 804 803 itau_phy,zjulian,dtime,nhoridbg,nidbg) 805 804 ! no vertical axis … … 809 808 cl_surf(4)='sic' 810 809 DO nsrf=1,nbsrf 811 CALL histdef(nidbg, cl_surf(nsrf),cl_surf(nsrf), "-", iim, &812 jjm+1,nhoridbg, 1, 1, 1, -99, 32, "inst", dtime,dtime)810 CALL histdef(nidbg, cl_surf(nsrf),cl_surf(nsrf), "-",nbp_lon, & 811 nbp_lat,nhoridbg, 1, 1, 1, -99, 32, "inst", dtime,dtime) 813 812 END DO 814 813 … … 1144 1143 ndexbg(:) = 0 1145 1144 CALL gath2cpl(tabindx,debugtab,knon,ni) 1146 CALL histwrite(nidbg,cl_surf(nsrf),itap,debugtab, iim*(jjm+1), ndexbg)1145 CALL histwrite(nidbg,cl_surf(nsrf),itap,debugtab,nbp_lon*nbp_lat, ndexbg) 1147 1146 ENDIF 1148 1147 … … 1318 1317 ! *sqrt(yu(i,1)*yu(i,1)+yv(i,1)*yv(i,1))) 1319 1318 ycdragm(i) = ust*ust/(1.+vent)/vent 1320 1319 ! print *,'ycdragm ust yu yv apres=',ycdragm(i),ust,yu(i,1),yv(i,1) 1321 1320 ENDDO 1322 1321 ENDIF … … 1343 1342 IF (ok_prescr_ust) then 1344 1343 DO i = 1, knon 1345 1344 ! print *,'ycdragm_x avant=',ycdragm_x(i) 1346 1345 vent= sqrt(yu_x(i,1)*yu_x(i,1)+yv_x(i,1)*yv_x(i,1)) 1347 1346 ycdragm_x(i) = ust*ust/(1.+vent)/vent 1348 1347 ! print *,'ycdragm_x ust yu yv apres=',ycdragm_x(i),ust,yu_x(i,1),yv_x(i,1) 1349 1348 ENDDO 1350 1349 ENDIF … … 1367 1366 ycdragm_w, ycdragh_w, zri1_w, pref_w ) 1368 1367 1369 ! --- special Dice. JYG+MPL 25112013 1368 ! --- special Dice. JYG+MPL 25112013 puis BOMEX 1370 1369 IF (ok_prescr_ust) then 1371 1370 DO i = 1, knon 1372 1371 ! print *,'ycdragm_w avant=',ycdragm_w(i) 1373 1372 vent= sqrt(yu_w(i,1)*yu_w(i,1)+yv_w(i,1)*yv_w(i,1)) 1374 1373 ycdragm_w(i) = ust*ust/(1.+vent)/vent 1375 1374 ! print *,'ycdragm_w ust yu yv apres=',ycdragm_w(i),ust,yu_w(i,1),yv_w(i,1) 1376 1375 ENDDO 1377 1376 ENDIF … … 1747 1746 y_flux_u1, y_flux_v1 ) 1748 1747 1749 ! Special DICE MPL 05082013 1748 ! Special DICE MPL 05082013 puis BOMEX 1750 1749 IF (ok_prescr_ust) THEN 1750 do j=1,knon 1751 1751 ! ysnow(:)=0. 1752 1752 ! yqsol(:)=0. … … 1761 1761 ! y_dflux_t(:)=0. 1762 1762 ! y_dflux_q(:)=0. 1763 y_flux_u1(:)=ycdragm(:)*(1.+sqrt(yu(:,1)*yu(:,1)+yv(:,1)*yv(:,1)))*yu(:,1)*ypplay(:,1)/RD/yt(:,1) 1764 y_flux_v1(:)=ycdragm(:)*(1.+sqrt(yu(:,1)*yu(:,1)+yv(:,1)*yv(:,1)))*yv(:,1)*ypplay(:,1)/RD/yt(:,1) 1763 y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1) 1764 y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1) 1765 enddo 1765 1766 ENDIF 1766 1767 … … 1797 1798 END DO 1798 1799 ! Martin 1800 ! Special DICE MPL 05082013 puis BOMEX MPL 20150410 1801 IF (ok_prescr_ust) THEN 1802 DO j=1,knon 1803 y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1) 1804 y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1) 1805 ENDDO 1806 ENDIF 1799 1807 1800 1808 CASE(is_oce) … … 1825 1833 print *,'arg de surf_ocean: ytsurf_new ',ytsurf_new 1826 1834 ENDIF 1835 ! Special DICE MPL 05082013 puis BOMEX MPL 20150410 1836 IF (ok_prescr_ust) THEN 1837 DO j=1,knon 1838 y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1) 1839 y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1) 1840 ENDDO 1841 ENDIF 1827 1842 1828 1843 CASE(is_sic) … … 1844 1859 y_flux_u1, y_flux_v1) 1845 1860 1861 ! Special DICE MPL 05082013 puis BOMEX MPL 20150410 1862 IF (ok_prescr_ust) THEN 1863 DO j=1,knon 1864 y_flux_u1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yu(j,1)*ypplay(j,1)/RD/yt(j,1) 1865 y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1) 1866 ENDDO 1867 ENDIF 1846 1868 1847 1869 CASE DEFAULT 1848 1870 WRITE(lunout,*) 'Surface index = ', nsrf 1849 1871 abort_message = 'Surface index not valid' 1850 CALL abort_ gcm(modname,abort_message,1)1872 CALL abort_physic(modname,abort_message,1) 1851 1873 END SELECT 1852 1874 … … 1886 1908 ! 1887 1909 IF (iflag_split .eq.0) THEN 1888 Kech_h(:) = ycdragh(:) * (1.0+SQRT(yu(:,1)**2+yv(:,1)**2)) * & 1889 ypplay(:,1)/(RD*yt(:,1)) 1910 do j=1,knon 1911 Kech_h(j) = ycdragh(j) * (1.0+SQRT(yu(j,1)**2+yv(j,1)**2)) * & 1912 ypplay(j,1)/(RD*yt(j,1)) 1913 enddo 1890 1914 ENDIF ! (iflag_split .eq.0) 1891 1915 … … 1895 1919 ENDDO 1896 1920 1897 y_d_ts(:) = ytsurf_new(:) - yts(:) 1921 do j=1,knon 1922 y_d_ts(j) = ytsurf_new(j) - yts(j) 1923 enddo 1898 1924 1899 1925 ELSE ! (ok_flux_surf) 1900 y_flux_t1(:) = yfluxsens(:) 1901 y_flux_q1(:) = -yevap(:) 1926 do j=1,knon 1927 y_flux_t1(j) = yfluxsens(j) 1928 y_flux_q1(j) = -yevap(j) 1929 enddo 1902 1930 ENDIF 1903 1931 … … 3060 3088 ! Security abort. This option has never been tested. To test, comment the following line. 3061 3089 ! abort_message='The fraction of the continents have changed!' 3062 ! CALL abort_ gcm(modname,abort_message,1)3090 ! CALL abort_physic(modname,abort_message,1) 3063 3091 nfois(nsrf) = nfois(nsrf) + 1 3064 3092 END IF
Note: See TracChangeset
for help on using the changeset viewer.
