Changeset 1746 for trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2
- Timestamp:
- Jul 24, 2017, 5:06:29 PM (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/dyn_em/module_initialize_real.F
r1724 r1746 21 21 USE module_soil_pre 22 22 USE module_date_time 23 use module_init_utilities24 23 #ifdef DM_PARALLEL 25 24 USE module_dm … … 119 118 REAL :: max_dz 120 119 121 INTEGER , PARAMETER :: nl_max = 1000 122 INTEGER :: nl_in 120 ! INTEGER , PARAMETER :: nl_max = 1000 123 121 ! REAL , DIMENSION(nl_max) :: grid%em_dn 124 REAL, DIMENSION(nl_max) :: pd_in 125 REAL, DIMENSION(nl_max) :: profdustq,profdustn 122 126 123 integer::oops1,oops2 127 124 … … 152 149 !LOGICAL :: interp_theta = .false. ! Wee et al. 2012 correction 153 150 REAL :: pfu, pfd, phm 154 REAL :: tpot 151 155 152 156 153 #ifdef DM_PARALLEL … … 1083 1080 !!END DO 1084 1081 1085 IF ( planet == "mars" ) then 1082 1086 1083 !--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 )1084 sizegcm=SIZE(grid%em_rh_gc(1,:,1)) 1085 ALLOCATE(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)) 1087 ALLOCATE(bp(MIN(ite,ide-1)-its+1,sizegcm, MIN(jte,jde-1)-jts+1)) 1088 1089 DO j = jts , MIN ( jde-1 , jte ) 1090 DO i = its , MIN (ide-1 , ite ) 1094 1091 1095 1092 !!! 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) 1097 1094 1098 1095 !!! Compute new sigma levels from old sigma levels with GCM (low-res) and WRF (hi-res) surface pressure 1099 1096 !!! (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)) 1101 1098 1102 1099 !!! Calculate new pressure levels 1103 grid%em_pd_gc(i,:,j)=bp(i,:,j)*grid%psfc(i,j)1104 1105 END DO1106 END DO1107 1108 DEALLOCATE(sig)1109 DEALLOCATE(bp)1100 grid%em_pd_gc(i,:,j)=bp(i,:,j)*grid%psfc(i,j) 1101 1102 END DO 1103 END DO 1104 1105 DEALLOCATE(sig) 1106 DEALLOCATE(bp) 1110 1107 1111 1108 !!****MARS who knows... 1112 grid%em_rh_gc(:,:,:)=0.1109 grid%em_rh_gc(:,:,:)=0. 1113 1110 1114 1111 … … 1116 1113 !grid%em_pd_gc=grid%em_p_gc 1117 1114 !!****MARS 1118 ELSE ! VENUS 1115 1119 1116 1120 1117 … … 1123 1120 !! dry top pressure (constant). 1124 1121 ! 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 1131 1127 !!****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_top1136 1137 END DO1138 END DO1128 DO j = jts , MIN ( jde-1 , jte ) 1129 DO i = its , MIN (ide-1 , ite ) 1130 1131 grid%em_mu0(i,j) = grid%psfc(i,j) - grid%p_top 1132 1133 END DO 1134 END DO 1139 1135 !!****MARS 1140 ELSE ! VENUS 1136 1141 1137 1142 1138 !! Compute the dry, hydrostatic surface pressure. 1143 1139 ! 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 ) 1149 1144 !!****MARS: voir remarques dans la routine 1150 1145 !!****MARS: dry hydrostatic pressure comes from the GCM ... … … 2299 2294 IF (( i .EQ. its ) .AND. ( j .EQ. jts )) print *, temp, k 2300 2295 !!! 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 2306 2297 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 2307 2298 END DO … … 2610 2601 !!NB: q2 is used for other purpose ... 2611 2602 2603 2612 2604 ! END IF 2613 2605 … … 2788 2780 temp1 = MAX(tiso,t00+A*LOG(grid%em_pb(i,k,j)/p00)) 2789 2781 temp2 = 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 2782 grid%em_t_init(i,k,j) = temp1*(p00/grid%em_pb(i,k,j))**(r_d/cp) - t0 2783 t_init_int(i,k,j) = temp2*(p00/pb_int )**(r_d/cp) - t0 2795 2784 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 2796 2785 END DO … … 4980 4969 ! temp = t00 + A*LOG(pb/p00) 4981 4970 temp = 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 4987 4972 alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm 4988 4973 END DO … … 5020 5005 ! temp = t00 + A*LOG(pb/p00) 5021 5006 temp = 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 5027 5008 alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm 5028 5009 znw(k+1) = znw(k) - dz*g / ( mub*alb(k) ) … … 5044 5025 ! temp = t00 + A*LOG(pb/p00) 5045 5026 temp = 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 5051 5028 alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm 5052 5029 znw(k+1) = znw(k) - dz*g / ( mub*alb(k) ) … … 5075 5052 ! temp = t00 + A*LOG(pb/p00) 5076 5053 temp = 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 5082 5055 alb(k) = (r_d/p1000mb)*(t_init+t0)*(pb/p1000mb)**cvpm 5083 5056 END DO … … 5747 5720 end subroutine build_sigma_hr 5748 5721 5722 5723 5724 5725 5749 5726 END MODULE module_initialize 5750 5727
Note: See TracChangeset
for help on using the changeset viewer.
