Ignore:
Timestamp:
Jul 24, 2017, 5:06:29 PM (9 years ago)
Author:
aslmd
Message:

MESOSCALE. makemeso module_initialize_les module_initialize_real reverted back to r1723 because commit r1724 was based on corrupted versions.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/dyn_em/module_initialize_real.F

    r1724 r1746  
    2121   USE module_soil_pre
    2222   USE module_date_time
    23    use module_init_utilities
    2423#ifdef DM_PARALLEL
    2524   USE module_dm
     
    119118      REAL :: max_dz
    120119
    121       INTEGER , PARAMETER :: nl_max = 1000
    122       INTEGER :: nl_in
     120!      INTEGER , PARAMETER :: nl_max = 1000
    123121!      REAL , DIMENSION(nl_max) :: grid%em_dn
    124       REAL, DIMENSION(nl_max) :: pd_in
    125       REAL, DIMENSION(nl_max) :: profdustq,profdustn
     122
    126123integer::oops1,oops2
    127124
     
    152149      !LOGICAL :: interp_theta = .false. ! Wee et al. 2012 correction
    153150      REAL :: pfu, pfd, phm
    154       REAL :: tpot
     151
    155152
    156153#ifdef DM_PARALLEL
     
    10831080!!END DO
    10841081
    1085 IF ( planet == "mars" ) then
     1082
    10861083!--get vertical size of the GCM input array and allocate new stuff
    1087   sizegcm=SIZE(grid%em_rh_gc(1,:,1))
    1088   ALLOCATE(sig(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
    1089   !ALLOCATE(ap(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
    1090   ALLOCATE(bp(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
    1091 
    1092   DO j = jts , MIN ( jde-1 , jte )
    1093   DO i = its , MIN (ide-1 , ite )
     1084sizegcm=SIZE(grid%em_rh_gc(1,:,1))
     1085ALLOCATE(sig(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
     1086!ALLOCATE(ap(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
     1087ALLOCATE(bp(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1))
     1088
     1089DO j = jts , MIN ( jde-1 , jte )
     1090DO i = its , MIN (ide-1 , ite )
    10941091
    10951092!!! Define old sigma levels for each column
    1096           sig(i,:,j)=grid%em_p_gc(i,:,j)/grid%em_psfc_gc(i,j)
     1093        sig(i,:,j)=grid%em_p_gc(i,:,j)/grid%em_psfc_gc(i,j)
    10971094
    10981095!!! Compute new sigma levels from old sigma levels with GCM (low-res) and WRF (hi-res) surface pressure
    10991096!!!                        (dimlevs,sigma_gcm, ps_gcm,                ps_hr,         sigma_hr)
    1100           CALL build_sigma_hr(sizegcm,sig(i,:,j),grid%em_psfc_gc(i,j),grid%psfc(i,j),bp(i,:,j))
     1097        CALL build_sigma_hr(sizegcm,sig(i,:,j),grid%em_psfc_gc(i,j),grid%psfc(i,j),bp(i,:,j))
    11011098
    11021099!!! Calculate new pressure levels
    1103           grid%em_pd_gc(i,:,j)=bp(i,:,j)*grid%psfc(i,j)
    1104 
    1105   END DO
    1106   END DO
    1107 
    1108   DEALLOCATE(sig)
    1109   DEALLOCATE(bp)
     1100        grid%em_pd_gc(i,:,j)=bp(i,:,j)*grid%psfc(i,j)
     1101
     1102END DO
     1103END DO
     1104
     1105DEALLOCATE(sig)
     1106DEALLOCATE(bp)
    11101107
    11111108!!****MARS who knows...
    1112   grid%em_rh_gc(:,:,:)=0.
     1109grid%em_rh_gc(:,:,:)=0.
    11131110
    11141111
     
    11161113!grid%em_pd_gc=grid%em_p_gc
    11171114!!****MARS
    1118 ELSE ! VENUS
     1115
    11191116
    11201117
     
    11231120         !!  dry top pressure (constant).
    11241121         !
    1125            CALL p_dts ( grid%em_mu0 , grid%em_intq_gc , grid%psfc , grid%p_top , &
    1126                         ids , ide , jds , jde , 1   , num_metgrid_levels , &
    1127                         ims , ime , jms , jme , 1   , num_metgrid_levels , &
    1128                         its , ite , jts , jte , 1   , num_metgrid_levels )
    1129 ENDIF
    1130 IF ( planet == "mars" ) then
     1122         !CALL p_dts ( grid%em_mu0 , grid%em_intq_gc , grid%psfc , grid%p_top , &
     1123         !             ids , ide , jds , jde , 1   , num_metgrid_levels , &
     1124         !             ims , ime , jms , jme , 1   , num_metgrid_levels , &
     1125         !             its , ite , jts , jte , 1   , num_metgrid_levels )
     1126
    11311127!!****MARS
    1132   DO j = jts , MIN ( jde-1 , jte )
    1133   DO i = its , MIN (ide-1 , ite )
    1134 
    1135      grid%em_mu0(i,j) = grid%psfc(i,j) - grid%p_top
    1136 
    1137   END DO
    1138   END DO
     1128DO j = jts , MIN ( jde-1 , jte )
     1129DO i = its , MIN (ide-1 , ite )
     1130
     1131   grid%em_mu0(i,j) = grid%psfc(i,j) - grid%p_top
     1132
     1133END DO
     1134END DO
    11391135!!****MARS
    1140 ELSE ! VENUS
     1136
    11411137   
    11421138         !!  Compute the dry, hydrostatic surface pressure.
    11431139         !
    1144            CALL p_dhs ( grid%em_pdhs , grid%ht , p00 , t00 , a , &
    1145                         ids , ide , jds , jde , kds , kde , &
    1146                         ims , ime , jms , jme , kms , kme , &
    1147                         its , ite , jts , jte , kts , kte )
    1148 ENDIF
     1140         !CALL p_dhs ( grid%em_pdhs , grid%ht , p00 , t00 , a , &
     1141         !             ids , ide , jds , jde , kds , kde , &
     1142         !             ims , ime , jms , jme , kms , kme , &
     1143         !             its , ite , jts , jte , kts , kte )
    11491144!!****MARS: voir remarques dans la routine
    11501145!!****MARS: dry hydrostatic pressure comes from the GCM ...
     
    22992294IF (( i .EQ. its ) .AND. ( j .EQ. jts )) print *, temp, k
    23002295!!! MODIF WRFV3.1 - parameter tiso
    2301                IF (planet .eq. "mars" ) THEN
    2302                  grid%em_t_init(i,k,j) = temp*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0
    2303                ELSE
    2304                  grid%em_t_init(i,k,j) = (temp**nu + nu*(TT00**nu)*log((p00/grid%em_pb(i,k,j))**rcp))**(1/nu) -t0
    2305                ENDIF
     2296               grid%em_t_init(i,k,j) = temp*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0
    23062297               grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
    23072298            END DO
     
    26102601!!NB: q2 is used for other purpose ...
    26112602
     2603
    26122604!      END IF
    26132605
     
    27882780temp1 = MAX(tiso,t00+A*LOG(grid%em_pb(i,k,j)/p00))
    27892781temp2 = MAX(tiso,t00+A*LOG(           pb_int/p00))
    2790 IF (planet .eq. "mars" ) THEN
    2791   grid%em_t_init(i,k,j) = temp1*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0
    2792   t_init_int(i,k,j)     = temp2*(p00/pb_int           )**(r_d/cp) - t0
    2793 ELSE
    2794 ENDIF
     2782grid%em_t_init(i,k,j) = temp1*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0
     2783t_init_int(i,k,j)     = temp2*(p00/pb_int           )**(r_d/cp) - t0
    27952784               grid%em_alb(i,k,j) = (r_d/p1000mb)*(grid%em_t_init(i,k,j)+t0)*(grid%em_pb(i,k,j)/p1000mb)**cvpm
    27962785            END DO
     
    49804969!            temp =             t00 + A*LOG(pb/p00)
    49814970temp = MAX ( tiso, t00 + A*LOG(pb/p00) )
    4982            IF (planet .eq. "mars" ) THEN
    4983               t_init = temp*(p00/pb)**(r_d/cp) - t0
    4984             ELSE
    4985               t_init = (temp**nu + nu*(TT00**nu)*log((p00/pb)**(rcp)))**(1/nu) - t0
    4986             ENDIF
     4971            t_init = temp*(p00/pb)**(r_d/cp) - t0
    49874972            alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
    49884973         END DO
     
    50205005!            temp =             t00 + A*LOG(pb/p00)
    50215006temp = MAX ( tiso, t00 + A*LOG(pb/p00) )
    5022            IF (planet .eq. "mars" ) THEN
    5023               t_init = temp*(p00/pb)**(r_d/cp) - t0
    5024             ELSE
    5025               t_init = (temp**nu + nu*(TT00**nu)*log((p00/pb)**(rcp)))**(1/nu) -t0
    5026             ENDIF
     5007            t_init = temp*(p00/pb)**(r_d/cp) - t0
    50275008            alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
    50285009            znw(k+1) = znw(k) - dz*g / ( mub*alb(k) )
     
    50445025!                  temp =             t00 + A*LOG(pb/p00)
    50455026temp = MAX ( tiso, t00 + A*LOG(pb/p00) )
    5046            IF (planet .eq. "mars" ) THEN
    5047               t_init = temp*(p00/pb)**(r_d/cp) - t0
    5048             ELSE
    5049               t_init = (temp**nu + nu*(TT00**nu)*log((p00/pb)**(rcp)))**(1/nu) -t0
    5050             ENDIF
     5027                  t_init = temp*(p00/pb)**(r_d/cp) - t0
    50515028                  alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
    50525029                  znw(k+1) = znw(k) - dz*g / ( mub*alb(k) )
     
    50755052!               temp =             t00 + A*LOG(pb/p00)
    50765053temp = MAX ( tiso, t00 + A*LOG(pb/p00) )
    5077            IF (planet .eq. "mars" ) THEN
    5078               t_init = temp*(p00/pb)**(r_d/cp) - t0
    5079             ELSE
    5080               t_init = (temp**nu + nu*(TT00**nu)*log((p00/pb)**(rcp)))**(1/nu) -t0
    5081             ENDIF
     5054               t_init = temp*(p00/pb)**(r_d/cp) - t0
    50825055               alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm
    50835056            END DO
     
    57475720      end subroutine build_sigma_hr
    57485721
     5722
     5723
     5724
     5725
    57495726END MODULE module_initialize
    57505727
Note: See TracChangeset for help on using the changeset viewer.