Changeset 3391


Ignore:
Timestamp:
Sep 16, 2018, 5:52:25 PM (6 years ago)
Author:
oboucher
Message:

Fields can now be passed to ORCHIDEE through surf_land_orchidee.
Fields are compressed in pbl_surface_mod and uncompressed in surf_land_orchidee.
Cosmetic changes, including in surf_land_mod.

Location:
LMDZ6/trunk/libf/phylmd
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/carbon_cycle_mod.F90

    r3390 r3391  
    8484!$OMP THREADPRIVATE(fco2_lu_inst)
    8585
    86 ! Following 4 fields will be allocated and initialized in surf_land_orchidee
    87   REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fCO2_nbp_inst  ! flux CO2 from land at one time step
    88 !$OMP THREADPRIVATE(fCO2_nbp_inst)
    89   REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fCO2_nep_inst  ! flux CO2 from land at one time step
    90 !$OMP THREADPRIVATE(fCO2_nep_inst)
    91   REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fCO2_fLuc_inst    ! Emission from land use change at one time step
    92 !$OMP THREADPRIVATE(fCO2_fLuc_inst)
    93   REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fCO2_fFire_inst  ! flux CO2 from land at one time step
    94 !$OMP THREADPRIVATE(fCO2_fFire_inst)
    95 
    96 
    9786! Calculated co2 field to be send to the ocean via the coupler and to ORCHIDEE
    9887  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: co2_send ! Field allocated in phyetat0
    … …  
    155144!$OMP THREADPRIVATE(cfmod2)
    156145
    157   REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: zcfields_in
    158 !$OMP THREADPRIVATE(zcfields_in)
    159 
    160   REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: zcfields_out
    161 !$OMP THREADPRIVATE(zcfields_out)
     146  CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_out_names
     147!$OMP THREADPRIVATE(field_out_names)
     148
     149  CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_in_names
     150!$OMP THREADPRIVATE(field_in_names)
     151
     152  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: fields_in   !  klon,nbcf_in
     153!$OMP THREADPRIVATE(fields_in)
     154
     155  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: yfields_in  !  knon,nbcf_in
     156!$OMP THREADPRIVATE(yfields_in)
     157
     158  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: fields_out  !  klon,nbcf_out
     159!$OMP THREADPRIVATE(fields_out)
     160
     161  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: yfields_out !  knon,nbcf_out
     162!$OMP THREADPRIVATE(yfields_out)
    162163
    163164  TYPE, PUBLIC :: co2_trac_type
    … …  
    830831 ENDIF ! planet_type
    831832
    832  ALLOCATE(zcfields_in(klon,nbcf_in),stat=error)
    833  IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation zcfields_in',1)
    834  ALLOCATE(zcfields_out(klon,nbcf_out),stat=error)
    835  IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation zcfields_out',1)
     833 ALLOCATE(fields_in(klon,nbcf_in),stat=error)
     834 IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation fields_in',1)
     835 ALLOCATE(yfields_in(klon,nbcf_in),stat=error)
     836 IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation yfields_in',1)
     837 ALLOCATE(fields_out(klon,nbcf_out),stat=error)
     838 IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation fields_out',1)
     839 ALLOCATE(yfields_out(klon,nbcf_out),stat=error)
     840 IF (error /= 0)  CALL abort_gcm(modname,'Pb in allocation yfields_out',1)
    836841
    837842END SUBROUTINE infocfields_init

  • LMDZ6/trunk/libf/phylmd/pbl_surface_mod.F90

    r3198 r3391  
    4040  !$OMP THREADPRIVATE(ftsoil)
    4141
    42   integer, save :: iflag_pbl_surface_t2m_bug
     42  INTEGER, SAVE :: iflag_pbl_surface_t2m_bug
    4343  !$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug)
    4444!FC
    … …  
    6868    REAL, DIMENSION(klon, nbsrf), INTENT(IN)          :: qsurf_rst
    6969    REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(IN) :: ftsoil_rst
    70 
    7170 
    7271! Local variables
    … …  
    7675    CHARACTER(len = 20)           :: modname = 'pbl_surface_init'
    7776   
    78 
    7977!****************************************************************************************
    8078! Allocate and initialize module variables with fields read from restart file.
    … …  
    9290    ALLOCATE(ftsoil(klon,nsoilmx,nbsrf), stat=ierr)
    9391    IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
    94 
    9592
    9693    fder(:)       = fder_rst(:)
    … …  
    9895    qsurf(:,:)    = qsurf_rst(:,:)
    9996    ftsoil(:,:,:) = ftsoil_rst(:,:,:)
    100 
    10197
    10298!****************************************************************************************
    … …  
    287283! treedrg--output-R- tree drag (m)               
    288284!
    289     USE carbon_cycle_mod,   ONLY : carbon_cycle_cpl, co2_send
     285    USE carbon_cycle_mod,   ONLY : carbon_cycle_cpl, carbon_cycle_tr, level_coupling_esm
     286    USE carbon_cycle_mod,   ONLY : co2_send, nbcf_out, fields_out, yfields_out, cfname_out
    290287    USE indice_sol_mod
    291288    USE time_phylmdz_mod,   ONLY : day_ini,annee_ref,itau_phy
    … …  
    379376    REAL, DIMENSION(klon),        INTENT(OUT)       :: zv1        ! v wind speed in first layer
    380377!albedo SB >>>
    381     REAL, DIMENSION(klon, nsw),        INTENT(OUT)       :: alb_dir_m,alb_dif_m
     378    REAL, DIMENSION(klon, nsw),   INTENT(OUT)       :: alb_dir_m,alb_dif_m
    382379!albedo SB <<<
    383380    ! Martin
    … …  
    509506! Other local variables
    510507!****************************************************************************************
     508! >> PC
     509    INTEGER                            :: ierr
     510    INTEGER                            :: n
     511! << PC
    511512    INTEGER                            :: iflag_split
    512513    INTEGER                            :: i, k, nsrf
    … …  
    587588!FC
    588589
    589 
    590590    CHARACTER(len=80)                  :: abort_message
    591591    CHARACTER(len=20)                  :: modname = 'pbl_surface'
    … …  
    724724    REAL, DIMENSION(klon)       :: ytrmb3_w
    725725!
    726     REAL, DIMENSION(klon)              :: uzon_x, vmer_x, speed_x, zri1_x, pref_x !speed_x, zri1_x, pref_x, added by Fuxing WANG, 04/03/2015
    727     REAL, DIMENSION(klon)              :: zgeo1_x, tair1_x, qair1_x, tairsol_x
    728 !
    729     REAL, DIMENSION(klon)              :: uzon_w, vmer_w, speed_w, zri1_w, pref_w !speed_w, zri1_w, pref_w, added by Fuxing WANG, 04/03/2015
    730     REAL, DIMENSION(klon)              :: zgeo1_w, tair1_w, qair1_w, tairsol_w
     726    REAL, DIMENSION(klon)       :: uzon_x, vmer_x, speed_x, zri1_x, pref_x !speed_x, zri1_x, pref_x, added by Fuxing WANG, 04/03/2015
     727    REAL, DIMENSION(klon)       :: zgeo1_x, tair1_x, qair1_x, tairsol_x
     728!
     729    REAL, DIMENSION(klon)       :: uzon_w, vmer_w, speed_w, zri1_w, pref_w !speed_w, zri1_w, pref_w, added by Fuxing WANG, 04/03/2015
     730    REAL, DIMENSION(klon)       :: zgeo1_w, tair1_w, qair1_w, tairsol_w
    731731
    732732!!! jyg le 25/03/2013
    … …  
    784784
    785785    REAL                               :: vent
    786 
    787 
    788 
    789 
    790 !!!
    791 
     786!
    792787! For debugging with IOIPSL
    793788    INTEGER, DIMENSION(nbp_lon*nbp_lat)    :: ndexbg
    … …  
    874869             CALL histdef(nidbg, cl_surf(nsrf),cl_surf(nsrf), "-",nbp_lon, &
    875870                  nbp_lat,nhoridbg, 1, 1, 1, -99, 32, "inst", dtime,dtime)
    876           END DO
     871          ENDDO
    877872
    878873          CALL histend(nidbg)
    879874          CALL histsync(nidbg)
    880875
    881        END IF
     876       ENDIF
    882877       
    883878    ENDIF
    … …  
    10121007!FC
    10131008
    1014 
     1009! >> PC
     1010!the yfields_out variable is defined in (klon,nbcf_out) even if it is used on
     1011!the ORCHIDEE grid and as such should be defined in yfields_out(knon,nbcf_out) but
     1012!the knon variable is not known at that level of pbl_surface_mod
     1013
     1014!the yfields_in variable is defined in (klon,nbcf_in) even if it is used on the
     1015!ORCHIDEE grid and as such should be defined in yfields_in(knon,nbcf_in) but the
     1016!knon variable is not known at that level of pbl_surface_mod
     1017
     1018   yfields_out(:,:) = 0.
     1019! << PC
    10151020
    10161021
    … …  
    11511156      DO i = 1, klon
    11521157        alb_m(i) = alb_m(i) + alb_dir_m(i,k)*SFRWL(k)
    1153       END DO
     1158      ENDDO
    11541159    ENDDO
    11551160!albedo SB <<<
    … …  
    11881193     DO i = 1, klon
    11891194      meansqT(i) = meansqT(i)+(ts(i,nsrf)-ztsol(i))**2 *pctsrf(i,nsrf)
    1190      END DO
    1191     END DO
     1195     ENDDO
     1196    ENDDO
    11921197    DO nsrf = 1, nbsrf
    11931198     DO i = 1, klon
    … …  
    11981203   ENDIF   ! iflag_order2_sollw == 1
    11991204!>al1
     1205
     1206! >> PC
     1207   IF (carbon_cycle_cpl .AND. carbon_cycle_tr .AND. nbcf_out.GT.0 ) THEN
     1208       r_co2_ppm(:) = co2_send(:)
     1209       DO n=1,nbcf_out
     1210           IF (cfname_out(n) == "atmco2" ) fields_out(:,n) = co2_send(:)
     1211       ENDDO
     1212   ENDIF
     1213   IF ( .NOT. carbon_cycle_tr .AND. nbcf_out.GT.0 ) THEN
     1214       r_co2_ppm(:) = co2_ppm     ! Constant field
     1215       DO n=1,nbcf_out
     1216           IF (cfname_out(n) == "atmco2" ) fields_out(:,n) = co2_ppm
     1217       ENDDO
     1218   ENDIF
     1219! << PC
    12001220
    12011221!****************************************************************************************
    … …  
    12311251          DO i=1,knon
    12321252             tabindx(i)=REAL(i)
    1233           END DO
     1253          ENDDO
    12341254          debugtab(:,:) = 0.
    12351255          ndexbg(:) = 0
    … …  
    12521272!albedo SB >>>
    12531273          yalb_vis(j) = alb_dir(i,1,nsrf)
    1254           if(nsw==6)then
     1274          IF (nsw==6) THEN
    12551275            yalb_vis(j)=(alb_dir(i,1,nsrf)*SFRWL(1)+alb_dir(i,2,nsrf)*SFRWL(2) &
    12561276              +alb_dir(i,3,nsrf)*SFRWL(3))/(SFRWL(1)+SFRWL(2)+SFRWL(3))
    1257           endif
     1277          ENDIF
    12581278!albedo SB <<<
    12591279          yrain_f(j) = rain_f(i)
    … …  
    12831303          y_delta_tsurf(j)=delta_tsurf(i,nsrf)
    12841304!!!
    1285        END DO
    1286 
     1305       ENDDO
     1306! >> PC
     1307!--compressing fields_out onto ORCHIDEE grid
     1308!--these fields are shared and used directly surf_land_orchidee_mod
     1309       DO n = 1, nbcf_out
     1310         DO j = 1, knon
     1311           i = ni(j)
     1312           yfields_out(j,n) = fields_out(i,n)
     1313         ENDDO
     1314       ENDDO
     1315! << PC
    12871316       DO k = 1, klev
    12881317          DO j = 1, knon
    … …  
    12931322          ENDDO
    12941323       ENDDO
     1324!
    12951325!!! jyg le 07/02/2012 et le 10/04/2013
    12961326        DO k = 1, klev+1
    … …  
    13061336          DO j = 1, knon
    13071337             i = ni(j)
    1308 !FC
    13091338             y_treedrg(j,k) =  treedrg(i,k,nsrf)
    1310 !            print*,nsrf, "treedrg ",y_treedrg(j,k),j,k
    1311 !FC
    1312 
    13131339             yu(j,k) = u(i,k)
    13141340             yv(j,k) = v(i,k)
    … …  
    13181344        ENDDO
    13191345!
    1320        IF (iflag_split .ge.1) THEN
     1346       IF (iflag_split.GE.1) THEN
    13211347!!! nrlmd le 02/05/2011
    13221348        DO k = 1, klev
    … …  
    13341360          ENDDO
    13351361        ENDDO
     1362
    13361363        IF (prt_level .ge. 10) THEN
    13371364          print *,'pbl_surface, wake_s(1), wake_dlt(1,:) ', wake_s(1), wake_dlt(1,:)
    13381365          print *,'pbl_surface, wake_s(1), wake_dlq(1,:) ', wake_s(1), wake_dlq(1,:)
    13391366        ENDIF
     1367
    13401368!!! nrlmd le 02/05/2011
    13411369        DO k = 1, klev+1
    … …  
    13761404             i = ni(j)
    13771405             ytsoil(j,k) = ftsoil(i,k,nsrf)
    1378           END DO
    1379        END DO
     1406          ENDDO
     1407       ENDDO
    13801408       
    13811409       ! qsol(water height in soil) only for bucket continental model
    … …  
    13841412             i = ni(j)
    13851413             yqsol(j) = qsol(i)
    1386           END DO
     1414          ENDDO
    13871415       ENDIF
    13881416       
    … …  
    14081436                * (ypaprs(i,1)-ypplay(i,1))
    14091437           speed(i) = SQRT(yu(i,1)**2+yv(i,1)**2)
    1410         END DO
     1438        ENDDO
    14111439        CALL cdrag(knon, nsrf, &
    14121440            speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1),&
    … …  
    14391467                * (ypaprs(i,1)-ypplay(i,1))
    14401468           speed_x(i) = SQRT(yu_x(i,1)**2+yv_x(i,1)**2)
    1441         END DO
     1469        ENDDO
    14421470        CALL cdrag(knon, nsrf, &
    14431471            speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),&
    … …  
    14661494                * (ypaprs(i,1)-ypplay(i,1))
    14671495           speed_w(i) = SQRT(yu_w(i,1)**2+yv_w(i,1)**2)
    1468         END DO
     1496        ENDDO
    14691497        CALL cdrag(knon, nsrf, &
    14701498            speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),&
    … …  
    16931721          DO i=1,knon
    16941722             r_co2_ppm(i) = co2_send(ni(i))
    1695           END DO
     1723          ENDDO
    16961724       ELSE
    16971725          r_co2_ppm(:) = co2_ppm     ! Constant field
    1698        END IF
    1699 
     1726       ENDIF
    17001727
    17011728!!! nrlmd le 02/05/2011  -----------------------On raccorde les 2 colonnes dans la couche 1
    … …  
    17901817             zgeo1(i) = RD * yt(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
    17911818                  * (ypaprs(i,1)-ypplay(i,1))
    1792           END DO
     1819          ENDDO
    17931820
    17941821          ! Calculate the temperature et relative humidity at 2m and the wind at 10m
    … …  
    17981825               yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
    17991826         
    1800        END IF
     1827       ENDIF
    18011828
    18021829!****************************************************************************************
    … …  
    18251852               y_flux_u1, y_flux_v1, &
    18261853               yveget,ylai,yheight )
     1854 
    18271855!FC quid qd yveget ylai yheight ne sont pas definit
    18281856!FC  yveget,ylai,yheight, &
    1829             if (ifl_pbltree .ge. 1) then
    1830             CALL   freinage(knon, yu, yv, yt, &
    1831 !              yveget,ylai, yheight,ypaprs,ypplay,y_d_u_frein,y_d_v_frein)
    1832               yveget,ylai, yheight,ypaprs,ypplay,y_treedrg, y_d_u_frein,y_d_v_frein)
    1833              endif
     1857            IF (ifl_pbltree .ge. 1) THEN
     1858              CALL   freinage(knon, yu, yv, yt, &
     1859!                yveget,ylai, yheight,ypaprs,ypplay,y_d_u_frein,y_d_v_frein)
     1860                yveget,ylai, yheight,ypaprs,ypplay,y_treedrg, y_d_u_frein,y_d_v_frein)
     1861            ENDIF
    18341862
    18351863               
    18361864! Special DICE MPL 05082013 puis BOMEX
    18371865       IF (ok_prescr_ust) THEN
    1838           do j=1,knon
     1866          DO j=1,knon
    18391867!         ysnow(:)=0.
    18401868!         yqsol(:)=0.
    … …  
    18511879          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)
    18521880          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)
    1853           enddo
     1881          ENDDO
    18541882      ENDIF
    1855 
    18561883     
    18571884       CASE(is_lic)
    … …  
    18851912             sissnow(i)   = ysissnow(j)
    18861913             runoff(i)    = yrunoff(j)
    1887           END DO
     1914          ENDDO
    18881915          ! Martin
    18891916! Special DICE MPL 05082013 puis BOMEX MPL 20150410
    … …  
    19701997!****************************************************************************************
    19711998
    1972        if (evap0>=0.) then
     1999       IF (evap0>=0.) THEn
    19732000          yevap(:)=evap0
    19742001          yevap(:)=RLVTT*evap0
    1975        endif
    1976 
     2002       ENDIF
    19772003
    19782004       y_d_ts(1:knon)   = ytsurf_new(1:knon) - yts(1:knon)
    … …  
    20002026!!  Test sur iflag_split retire le 2/02/2018, sans vraiment comprendre la raison de ce test. (jyg)
    20012027!!          IF (iflag_split .eq.0) THEN
    2002              do j=1,knon
     2028             DO j=1,knon
    20032029             Kech_h(j) = ycdragh(j) * (1.0+SQRT(yu(j,1)**2+yv(j,1)**2)) * &
    20042030                  ypplay(j,1)/(RD*yt(j,1))
    2005              enddo
     2031             ENDDO
    20062032!!          ENDIF ! (iflag_split .eq.0)
    20072033
    … …  
    20112037          ENDDO
    20122038
    2013           do j=1,knon
     2039          DO j=1,knon
    20142040          y_d_ts(j) = ytsurf_new(j) - yts(j)
    2015           enddo
     2041          ENDDO
    20162042
    20172043        ELSE ! (ok_flux_surf)
    2018           do j=1,knon
     2044          DO j=1,knon
    20192045          y_flux_t1(j) =  yfluxsens(j)
    20202046          y_flux_q1(j) = -yevap(j)
    2021           enddo
     2047          ENDDO
    20222048        ENDIF
    20232049
    … …  
    22482274             y_d_v(j,k)  = y_d_v(j,k) * ypct(j)
    22492275!FC
    2250               if  (nsrf .EQ. is_ter .and. ifl_pbltree .ge. 1  ) then
     2276             IF  (nsrf .EQ. is_ter .and. ifl_pbltree .ge. 1  ) THEn
    22512277!            if (y_d_u_frein(j,k).ne.0. ) then
    22522278!        print*, nsrf,'IS_TER ++', y_d_u_frein(j,k)*ypct(j),y_d_u(j,k),j,k
    2253 !            endif
    2254              y_d_u(j,k) =y_d_u(j,k) + y_d_u_frein(j,k)*ypct(j)
    2255              y_d_v(j,k) =y_d_v(j,k) + y_d_v_frein(j,k)*ypct(j)
    2256              treedrg(i,k,nsrf)=y_treedrg(j,k)
    2257              else
    2258              treedrg(i,k,nsrf)=0.
    2259                endif
     2279!            ENDIF
     2280               y_d_u(j,k) =y_d_u(j,k) + y_d_u_frein(j,k)*ypct(j)
     2281               y_d_v(j,k) =y_d_v(j,k) + y_d_v_frein(j,k)*ypct(j)
     2282               treedrg(i,k,nsrf)=y_treedrg(j,k)
     2283             ELSE
     2284               treedrg(i,k,nsrf)=0.
     2285             ENDIF
    22602286!FC
    2261 
    22622287             flux_t(i,k,nsrf) = y_flux_t(j,k)
    22632288             flux_q(i,k,nsrf) = y_flux_q(j,k)
    22642289             flux_u(i,k,nsrf) = y_flux_u(j,k)
    22652290             flux_v(i,k,nsrf) = y_flux_v(j,k)
    2266 
    2267 
    22682291           ENDDO
    22692292        ENDDO
    2270 
    22712293
    22722294       ELSE  !(iflag_split .eq.0)
    … …  
    23472369          d_ts(i,nsrf) = y_d_ts(j)
    23482370!albedo SB >>>
    2349           do k=1,nsw
    2350           alb_dir(i,k,nsrf) = yalb_dir_new(j,k)
    2351           alb_dif(i,k,nsrf) = yalb_dif_new(j,k)
    2352           enddo
     2371          DO k=1,nsw
     2372            alb_dir(i,k,nsrf) = yalb_dir_new(j,k)
     2373            alb_dif(i,k,nsrf) = yalb_dif_new(j,k)
     2374          ENDDO
    23532375!albedo SB <<<
    23542376          snow(i,nsrf) = ysnow(j) 
    … …  
    23622384          dflux_t(i) = dflux_t(i) + y_dflux_t(j)
    23632385          dflux_q(i) = dflux_q(i) + y_dflux_q(j)
    2364        END DO
     2386       ENDDO
    23652387
    23662388!      print*,'Dans pbl OK2'
    … …  
    23872409          kh_w(i) = kh_w(i) + Kech_h_w(j)*ypct(j)
    23882410!!!
    2389         END DO
     2411        ENDDO
    23902412!!!     
    23912413       ENDIF  ! (iflag_split .ge.1)
    … …  
    24222444              tke_x(i,k,is_ave) = tke_x(i,k,is_ave) + ytke(j,k)*ypct(j)
    24232445!>jyg
    2424            END DO
    2425         END DO
     2446           ENDDO
     2447        ENDDO
    24262448
    24272449       ELSE  ! (iflag_split .eq.0)
    … …  
    24492471             zcoefh(i,k,is_ave) = zcoefh(i,k,is_ave) + ycoefh(j,k)*ypct(j)
    24502472             zcoefm(i,k,is_ave) = zcoefm(i,k,is_ave) + ycoefm(j,k)*ypct(j)
    2451           END DO
    2452        END DO
     2473          ENDDO
     2474       ENDDO
    24532475
    24542476!      print*,'Dans pbl OK3'
    … …  
    24582480             i = ni(j)
    24592481             qsol(i) = yqsol(j)
    2460           END DO
    2461        END IF
     2482          ENDDO
     2483       ENDIF
    24622484       
    24632485!jyg<
    … …  
    24682490             i = ni(j)
    24692491             ftsoil(i, k, nsrf) = ytsoil(j,k)
    2470           END DO
    2471        END DO
     2492          ENDDO
     2493       ENDDO
    24722494       
    24732495!!! jyg le 07/02/2012
    … …  
    24922514!!           d_wake_dlt(i,k) = d_wake_dlt(i,k) + y_d_t_w(i,k)-y_d_t_x(i,k)
    24932515!!           d_wake_dlq(i,k) = d_wake_dlq(i,k) + y_d_q_w(i,k)-y_d_q_x(i,k)
    2494           END DO
    2495         END DO
     2516          ENDDO
     2517        ENDDO
    24962518!!!
    24972519       ENDIF  ! (iflag_split .ge.1)
    … …  
    25062528             d_u(i,k) = d_u(i,k) + y_d_u(j,k)
    25072529             d_v(i,k) = d_v(i,k) + y_d_v(j,k)
    2508           END DO
    2509        END DO
     2530          ENDDO
     2531       ENDDO
    25102532
    25112533!      print*,'Dans pbl OK4'
    … …  
    25422564          tairsol(j) = yts(j) + y_d_ts(j)
    25432565          qairsol(j) = yqsurf(j)
    2544         END DO
     2566        ENDDO
    25452567       ELSE  ! (iflag_split .eq.0)
    25462568        DO j=1, knon
    … …  
    25542576          tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf(j)
    25552577          qairsol(j) = yqsurf(j)
    2556         END DO
     2578        ENDDO
    25572579        DO j=1, knon
    25582580          uzon_w(j) = yu_w(j,1) + y_d_u_w(j,1)
    … …  
    25642586          tairsol_w(j) = tairsol(j) + (1.- ywake_s(j))*y_delta_tsurf(j)
    25652587          qairsol(j) = yqsurf(j)
    2566         END DO
     2588        ENDDO
    25672589!!!     
    25682590       ENDIF  ! (iflag_split .eq.0)
    … …  
    25762598          psfce(j)=ypaprs(j,1)
    25772599          patm(j)=ypplay(j,1)
    2578        END DO
     2600       ENDDO
    25792601
    25802602       IF (iflag_pbl_surface_t2m_bug==1) THEN
    … …  
    26172639          u10m(i,nsrf)=(yu10m(j) * uzon(j))/SQRT(uzon(j)**2+vmer(j)**2)
    26182640          v10m(i,nsrf)=(yu10m(j) * vmer(j))/SQRT(uzon(j)**2+vmer(j)**2)
    2619         END DO
     2641        ENDDO
    26202642       ELSE  !(iflag_split .eq.0)
    26212643        DO j=1, knon
    … …  
    26272649          u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
    26282650          v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
    2629         END DO
     2651        ENDDO
    26302652        DO j=1, knon
    26312653          i = ni(j)
    … …  
    26402662          u10m(i,nsrf) = u10m_x(i,nsrf) + wake_s(i)*(u10m_w(i,nsrf)-u10m_x(i,nsrf))
    26412663          v10m(i,nsrf) = v10m_x(i,nsrf) + wake_s(i)*(v10m_w(i,nsrf)-v10m_x(i,nsrf))
    2642         END DO
     2664        ENDDO
    26432665!!!
    26442666       ENDIF  ! (iflag_split .eq.0)
    … …  
    26612683             rh2m(i)   = rh2m(i)   + yq2m(j)/zx_qs1 * pctsrf(i,nsrf)
    26622684             qsat2m(i) = qsat2m(i) + zx_qs1  * pctsrf(i,nsrf)
    2663           END DO
     2685          ENDDO
    26642686       ELSE  ! (iflag_split .eq.0)
    26652687          DO j = 1, knon
    … …  
    26732695             rh2m_x(i)   = rh2m_x(i)   + yq2m_x(j)/zx_qs1 * pctsrf(i,nsrf)
    26742696             qsat2m_x(i) = qsat2m_x(i) + zx_qs1  * pctsrf(i,nsrf)
    2675           END DO
     2697          ENDDO
    26762698          DO j = 1, knon
    26772699             i=ni(j)
    … …  
    26842706             rh2m_w(i)   = rh2m_w(i)   + yq2m_w(j)/zx_qs1 * pctsrf(i,nsrf)
    26852707             qsat2m_w(i) = qsat2m_w(i) + zx_qs1  * pctsrf(i,nsrf)
    2686           END DO
     2708          ENDDO
    26872709!!!     
    26882710       ENDIF  ! (iflag_split .eq.0)
    26892711!!!
    2690        END IF
     2712       ENDIF
    26912713!
    26922714       IF (prt_level >=10) THEN
    … …  
    27612783          trmb2(i,nsrf)  = ytrmb2(j)
    27622784          trmb3(i,nsrf)  = ytrmb3(j)
    2763         END DO
     2785        ENDDO
    27642786        IF (prt_level >=10) THEN
    27652787          print *, 'After HBTM: pblh ', pblh
    … …  
    27812803          trmb2_x(i,nsrf)  = ytrmb2_x(j)
    27822804          trmb3_x(i,nsrf)  = ytrmb3_x(j)
    2783         END DO
     2805        ENDDO
    27842806        IF (prt_level >=10) THEN
    27852807          print *, 'After HBTM: pblh_x ', pblh_x
    … …  
    28002822          trmb2_w(i,nsrf)  = ytrmb2_w(j)
    28012823          trmb3_w(i,nsrf)  = ytrmb3_w(j)
    2802         END DO
     2824        ENDDO
    28032825        IF (prt_level >=10) THEN
    28042826          print *, 'After HBTM: pblh_w ', pblh_w
    … …  
    28212843!
    28222844!****************************************************************************************
    2823     END DO loop_nbsrf
     2845    ENDDO loop_nbsrf
    28242846
    28252847!****************************************************************************************
    … …  
    28622884              zxfluxu_w(i,k) = zxfluxu_w(i,k) + flux_u_w(i,k,nsrf) * pctsrf(i,nsrf)
    28632885              zxfluxv_w(i,k) = zxfluxv_w(i,k) + flux_v_w(i,k,nsrf) * pctsrf(i,nsrf)
    2864             END DO
    2865           END DO
    2866         END DO
     2886            ENDDO
     2887          ENDDO
     2888        ENDDO
    28672889
    28682890    DO i = 1, klon
    28692891      zxsens_x(i) = - zxfluxt_x(i,1)
    28702892      zxsens_w(i) = - zxfluxt_w(i,1)
    2871     END DO
     2893    ENDDO
    28722894!!!
    28732895       ENDIF  ! (iflag_split .ge.1)
    … …  
    28812903             zxfluxu(i,k) = zxfluxu(i,k) + flux_u(i,k,nsrf) * pctsrf(i,nsrf)
    28822904             zxfluxv(i,k) = zxfluxv(i,k) + flux_v(i,k,nsrf) * pctsrf(i,nsrf)
    2883           END DO
    2884        END DO
    2885     END DO
     2905          ENDDO
     2906       ENDDO
     2907    ENDDO
    28862908
    28872909    DO i = 1, klon
    … …  
    29282950          zxtsol(i)    = zxtsol(i)    + ts(i,nsrf)      * pctsrf(i,nsrf)
    29292951          zxfluxlat(i) = zxfluxlat(i) + fluxlat(i,nsrf) * pctsrf(i,nsrf)
    2930        END DO
    2931     END DO
     2952       ENDDO
     2953    ENDDO
    29322954!
    29332955!<al1 order 2 correction to zxtsol, for radiation computations (main atm effect of Ts)
    … …  
    29372959     DO i = 1, klon
    29382960      meansqT(i) = meansqT(i)+(ts(i,nsrf)-zxtsol(i))**2 *pctsrf(i,nsrf)
    2939      END DO
    2940     END DO
     2961     ENDDO
     2962    ENDDO
    29412963    zxtsol(:) = zxtsol(:)+1.5*meansqT(:)/zxtsol(:)
    29422964   ENDIF   ! iflag_order2_sollw == 1
    … …  
    29642986          s_trmb2(i)  = s_trmb2(i)  + trmb2(i,nsrf) * pctsrf(i,nsrf)
    29652987          s_trmb3(i)  = s_trmb3(i)  + trmb3(i,nsrf) * pctsrf(i,nsrf)
    2966          END DO
    2967         END DO
     2988         ENDDO
     2989        ENDDO
    29682990       ELSE  !(iflag_split .eq.0)
    29692991        DO nsrf = 1, nbsrf
    … …  
    30013023          s_trmb2(i)  = s_trmb2(i)  + trmb2_x(i,nsrf) * pctsrf(i,nsrf)
    30023024          s_trmb3(i)  = s_trmb3(i)  + trmb3_x(i,nsrf) * pctsrf(i,nsrf)
    3003          END DO
    3004         END DO
     3025         ENDDO
     3026        ENDDO
    30053027        DO i = 1, klon         
    30063028          qsat2m(i)= qsat2m_x(i)+ wake_s(i)*(qsat2m_x(i)-qsat2m_w(i))
    3007         END DO
     3029        ENDDO
    30083030!!!
    30093031       ENDIF  ! (iflag_split .eq.0)
    … …  
    30603082          zxqsurf(i) = zxqsurf(i) + qsurf(i,nsrf) * pctsrf(i,nsrf)
    30613083          zxsnow(i)  = zxsnow(i)  + snow(i,nsrf)  * pctsrf(i,nsrf)
    3062        END DO
    3063     END DO
     3084       ENDDO
     3085    ENDDO
    30643086
    30653087! Premier niveau de vent sortie dans physiq.F
    30663088    zu1(:) = u(:,1)
    30673089    zv1(:) = v(:,1)
    3068 
    30693090
    30703091  END SUBROUTINE pbl_surface
    … …  
    32003221                u10m(i,nsrf)  = u10m(i,nsrf_comp1)
    32013222                v10m(i,nsrf)  = v10m(i,nsrf_comp1)
    3202                 if (iflag_pbl > 1) then
     3223                IF (iflag_pbl > 1) THEN
    32033224                 tke(i,:,nsrf) = tke(i,:,nsrf_comp1)
    3204                 endif
     3225                ENDIF
    32053226                mfois(nsrf) = mfois(nsrf) + 1
    32063227                ! F. Codron sensible default values for ocean and sea ice
    … …  
    32103231                      alb_dir(i,k,nsrf) = 0.06 ! typical Ocean albedo
    32113232                      alb_dif(i,k,nsrf) = 0.06
    3212                     END DO
     3233                    ENDDO
    32133234                ELSE IF (nsrf.EQ.is_sic) THEN
    32143235                    tsurf(i,nsrf) = 273.15 ! Melting ice
    … …  
    32163237                      alb_dir(i,k,nsrf) = 0.3 ! thin ice
    32173238                      alb_dif(i,k,nsrf) = 0.3
    3218                     END DO
    3219                 END IF
     3239                    ENDDO
     3240                ENDIF
    32203241                ! F. Codron
    32213242             ELSE
    … …  
    32373258                u10m(i,nsrf)  = u10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + u10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
    32383259                v10m(i,nsrf)  = v10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + v10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
    3239                 if (iflag_pbl > 1) then
     3260                IF (iflag_pbl > 1) THEN
    32403261                 tke(i,:,nsrf) = tke(i,:,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tke(i,:,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
    3241                 endif
     3262                ENDIF
    32423263           
    32433264                ! Security abort. This option has never been tested. To test, comment the following line.
    … …  
    32453266!                CALL abort_physic(modname,abort_message,1)
    32463267                nfois(nsrf) = nfois(nsrf) + 1
    3247              END IF
     3268             ENDIF
    32483269             snow(i,nsrf)     = 0.
    32493270             agesno(i,nsrf)   = 0.
    … …  
    32513272          ELSE
    32523273             pfois(nsrf) = pfois(nsrf)+ 1
    3253           END IF
    3254        END DO
     3274          ENDIF
     3275       ENDDO
    32553276       
    3256     END DO
     3277    ENDDO
    32573278
    32583279  END SUBROUTINE pbl_surface_newfrac
    3259 
    32603280! 
    32613281!****************************************************************************************
    32623282! 
    3263 
    32643283END MODULE pbl_surface_mod
    3265 

  • LMDZ6/trunk/libf/phylmd/surf_land_mod.F90

    r3102 r3391  
    2424    USE dimphy
    2525    USE surface_data, ONLY    : ok_veget
     26! >> PC
     27    USE carbon_cycle_mod
     28! << PC
    2629
    2730    ! See comments in each module surf_land_orchidee_xxx for compatiblity with ORCHIDEE
    … …  
    4750    USE indice_sol_mod
    4851
     52! >> PC
     53    USE print_control_mod, ONLY: lunout
     54! << PC
     55
    4956    INCLUDE "dimsoil.h"
    5057    INCLUDE "YOMCST.h"
    5158    INCLUDE "clesphys.h"
    5259    INCLUDE "dimpft.h"
    53 
    5460
    5561! Input variables 
    … …  
    118124!albedo SB <<<
    119125
    120 
    121126!****************************************************************************************
    122127! Choice between call to vegetation model (ok_veget=true) or simple calculation below
    … …  
    159164            emis_new, z0m, z0h, qsurf, &
    160165            veget, lai, height)       
    161 
    162 
    163166! 
    164167!* Add contribution of relief to surface roughness
    … …  
    198201
    199202!albedo SB >>>
    200 
    201 
    202      select case(NSW)
    203      case(2)
     203     SELECT CASE(NSW)
     204     CASE(2)
    204205       alb_dir_new(1:knon,1)=alb1_new(1:knon)
    205206       alb_dir_new(1:knon,2)=alb2_new(1:knon)
    206      case(4)
     207     CASE(4)
    207208       alb_dir_new(1:knon,1)=alb1_new(1:knon)
    208209       alb_dir_new(1:knon,2)=alb2_new(1:knon)
    209210       alb_dir_new(1:knon,3)=alb2_new(1:knon)
    210211       alb_dir_new(1:knon,4)=alb2_new(1:knon)
    211      case(6)
     212     CASE(6)
    212213       alb_dir_new(1:knon,1)=alb1_new(1:knon)
    213214       alb_dir_new(1:knon,2)=alb1_new(1:knon)
    … …  
    216217       alb_dir_new(1:knon,5)=alb2_new(1:knon)
    217218       alb_dir_new(1:knon,6)=alb2_new(1:knon)
    218      end select
    219 alb_dif_new=alb_dir_new
     219     END SELECT
     220
     221     alb_dif_new=alb_dir_new
    220222!albedo SB <<<
    221 
    222 
    223223   
    224224  END SUBROUTINE surf_land

  • LMDZ6/trunk/libf/phylmd/surf_land_orchidee_mod.F90

    r3102 r3391  
    2626  USE mod_grid_phy_lmdz
    2727  USE mod_phys_lmdz_para, mpi_root_rank=>mpi_master
     28  USE carbon_cycle_mod, ONLY : nbcf_in_orc, nbcf_out, fields_in, yfields_in, yfields_out, cfname_in, cfname_out
    2829
    2930  IMPLICIT NONE
    … …  
    4849       veget, lai, height )
    4950
    50 
    5151    USE mod_surf_para
    5252    USE mod_synchro_omp
    53     USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
     53    USE carbon_cycle_mod
    5454    USE indice_sol_mod
    5555    USE print_control_mod, ONLY: lunout
    … …  
    9696!   ps           pression au sol
    9797!   radsol       rayonnement net aus sol (LW + SW)
    98 !   
    9998!
    10099! output:
    … …  
    113112    INCLUDE "YOMCST.h"
    114113    INCLUDE "dimpft.h"
    115 
    116 
    117  
    118114!
    119115! Parametres d'entree
    … …  
    149145    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
    150146
    151 
    152147! Local
    153148!****************************************************************************************
    154     INTEGER                                   :: ij, jj, igrid, ireal, index
     149    INTEGER                                   :: ij, jj, igrid, ireal, index, nb
    155150    INTEGER                                   :: error
    156151    REAL, DIMENSION(klon)                     :: swdown_vrai
    … …  
    365360! carbon_cycle_cpl not possible with this interface and version of ORHCHIDEE
    366361!
    367        IF (carbon_cycle_cpl) THEN
    368           abort_message='carbon_cycle_cpl not yet possible with this interface of ORCHIDEE'
    369           CALL abort_physic(modname,abort_message,1)
    370        END IF
     362! >> PC
     363!       IF (carbon_cycle_cpl) THEN
     364!          abort_message='carbon_cycle_cpl not yet possible with this interface of ORCHIDEE'
     365!          CALL abort_physic(modname,abort_message,1)
     366!       END IF
     367! << PC
    371368       
    372369    ENDIF                          ! (fin debut)
    373370 
    374 
    375371!
    376372! Appel a la routine sols continentaux
    … …  
    413409       IF (knon > 0) THEN
    414410
     411         print *,'OB before intersurf=', SIZE(cfname_in), SIZE(cfname_out)
    415412#ifdef CPP_VEGET
    416413         CALL intersurf_initialize_gathered (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, &
    … …  
    421418               evap, fluxsens, fluxlat, coastalflow, riverflow, &
    422419               tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0m_new, &   
    423                lon_scat, lat_scat, q2m, t2m, z0h_new, nvm_orch)
     420! >> PC
     421               !lon_scat, lat_scat, q2m, t2m, z0h_new, nvm_orch)
     422               lon_scat, lat_scat, q2m, t2m, z0h_new, nvm_orch, &
     423               field_out_names=cfname_out, field_in_names=cfname_in(1:nbcf_in_orc))
     424! << PC
    424425#endif         
    425426       ENDIF
    … …  
    430431
    431432    ENDIF
    432 
    433433   
    434434!  swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
    … …  
    452452            lon_scat, lat_scat, q2m, t2m, z0h_new(1:knon),&
    453453            veget(1:knon,:),lai(1:knon,:),height(1:knon,:),&
     454            fields_out=yfields_out(1:knon,1:nbcf_out),  &
     455            fields_in=yfields_in(1:knon,1:nbcf_in_orc), &
    454456            coszang=yrmu0(1:knon))
    455457#endif       
    … …  
    480482    IF (debut) CALL Finalize_surf_para
    481483
     484! >> PC
     485! Decompressing variables into LMDz for the module carbon_cycle_mod
     486! nbcf_in can be zero, in which case the loop does not operate
     487! fields_in can then used elsewhere in the model
     488     
     489     fields_in(:,:)=0.0
     490
     491     DO nb=1, nbcf_in_orc
     492       DO igrid = 1, knon
     493        ireal = knindex(igrid)
     494        fields_in(ireal,nb)=yfields_in(igrid,nb)
     495       ENDDO
     496       WRITE(*,*) 'surf_land_orchidee_mod --- yfields_in :',cfname_in(nb)
     497     ENDDO
     498! >> PC
    482499   
    483500  END SUBROUTINE surf_land_orchidee
    … …  
    541558!****************************************************************************************
    542559   
    543    
    544560    IF (is_omp_root) THEN         
    545561     
    … …  
    566582      ENDDO
    567583    ENDIF
    568    
    569584   
    570585  END SUBROUTINE Get_orchidee_communicator
    … …  
    628643       off_ini(4,3) =  1          ; off_ini(5,3) = nbp_lon           ; off_ini(6,3) = nbp_lon - 1
    629644       off_ini(7,3) = -1          ; off_ini(8,3) = - nbp_lon - 1
    630 !
    631645!
    632646! Attention aux poles
    … …  
    645659         ENDDO
    646660       ELSE
    647        print*,'sonia : knon_glo,ij,jj', knon_glo, ij,jj
    648661       
    649662       DO igrid = 1, knon_glo
Note: See TracChangeset for help on using the changeset viewer.