Changeset 1746 for trunk/MESOSCALE/LMD_MM_MARS/SRC/LES/modif_mars

Timestamp:

Jul 24, 2017, 5:06:29 PM (8 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:

• trunk/MESOSCALE/LMD_MM_MARS/SRC/LES/modif_mars/module_initialize_les.F (modified) (24 diffs)

trunk/MESOSCALE/LMD_MM_MARS/SRC/LES/modif_mars/module_initialize_les.F

@@ -86 +86 @@
 
    INTEGER, PARAMETER :: nl_max = 1000
-   REAL, DIMENSION(nl_max) :: zk, p_in, theta, Tz, rho, u, v, qv, pd_in
+   REAL, DIMENSION(nl_max) :: zk, p_in, theta, rho, u, v, qv, pd_in
    INTEGER :: nl_in
 
@@ -116 +116 @@
  ! for mode 3
  REAL, DIMENSION(nl_max) :: profdustq,profdustn
- REAL, DIMENSION(nl_max) :: hrsw,hrlw,hrdyn
- REAL, DIMENSION(nl_max) :: trac
- REAL, DIMENSION(nl_max) :: prescribed_sw,prescribed_lw,prescribed_dyn
- REAL, DIMENSION(nl_max) :: venus_hrdyn
- REAL, DIMENSION(nl_max) :: altitude
+ REAL, DIMENSION(nl_max) :: prescribed_sw,prescribed_lw
 !!MARS
 
@@ -127 +123 @@
       !INTEGER :: hypsometric_opt = 2 ! Wee et al. 2012 correction
 
+character(len=10) :: planet
 
 #ifdef DM_PARALLEL
 #    include <data_calls.inc>
 #endif
+ 
+   call init_planet_constants
 
    SELECT CASE ( model_data_order )
@@ -173 +172 @@
 
 
-   stretch_grid = .false.
+   !stretch_grid = .false.
 !  FOR LES, set stretch to false
-   !stretch_grid = .true.
+   stretch_grid = .true.
    delt = 3.
 !   z_scale = .50
 !   z_scale = .10
 !   z_scale = .25
-!   z_scale = .1
+!   z_scale = .15
    pi = 2.*asin(1.0)
    write(6,*) ' pi is ',pi
@@ -303 +302 @@
    grid%rdx = 1./config_flags%dx
    grid%rdy = 1./config_flags%dy
+
 !  get the sounding from the ascii sounding file, first get dry sounding and 
 !  calculate base state
@@ -310 +310 @@
   write(6,*) ' getting dry sounding for base state '
 
-  CALL get_sounding( zk, p_in, pd_in, theta, Tz, rho, u, v, qv, dry_sounding, nl_max, nl_in )
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in )
   ENDIF
   CALL wrf_dm_bcast_real( zk , nl_max )
@@ -316 +316 @@
   CALL wrf_dm_bcast_real( pd_in , nl_max )
   CALL wrf_dm_bcast_real( theta , nl_max )
-  CALL wrf_dm_bcast_real( Tz , nl_max )
   CALL wrf_dm_bcast_real( rho , nl_max )
   CALL wrf_dm_bcast_real( u , nl_max )
@@ -385 +384 @@
   ENDDO
 
-  xs=ide/2 -25
-  !xs=ids   -3
-  !xe=xs + 6
-  xe=xs + 25
-  !ys=jde/2 -3
-  ys=jde/2 -25
-  !ye=ys + 6
-  ye=ys + 25
-  mtn_ht = 1000
+  xs=ide/2 -3
+  xs=ids   -3
+  xe=xs + 6
+  ys=jde/2 -3
+  ye=ys + 6
+  mtn_ht = 500
 #ifdef MTN
   DO j=max(ys,jds),min(ye,jde-1)
   DO i=max(xs,ids),min(xe,ide-1)
-     grid%ht(i,j) = alt_input + mtn_ht * 0.25 * &
+     grid%ht(i,j) = mtn_ht * 0.25 * &
                ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) ) * &
                ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) )
@@ -438 +434 @@
       p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top
       grid%pb(i,k,j) = p_level
-      grid%t_init(i,k,j) = interp_0_log( theta, p_in, p_level, nl_in ) - t0
-      grid%tz_init(i,k,j) = interp_0_log( Tz, p_in, p_level, nl_in )
+      grid%t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0
       grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm
     ENDDO
@@ -463 +458 @@
   ENDDO
   ENDDO
+
   IF ( wrf_dm_on_monitor() ) THEN
     write(6,*) ' ptop is ',grid%p_top
@@ -472 +468 @@
   write(6,*) ' getting moist sounding for full state '
   dry_sounding = .false.
-  CALL get_sounding( zk, p_in, pd_in, theta, Tz, rho, u, v, qv, dry_sounding, nl_max, nl_in )
+  CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in )
 
   DO J = jts, min(jde-1,jte)
@@ -495 +491 @@
       p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
 
-      moist(i,k,j,P_QV) = interp_0_log( qv, pd_in, p_level, nl_in )
-      grid%t_1(i,k,j)          = interp_0_log( theta, pd_in, p_level, nl_in ) - t0
+      moist(i,k,j,P_QV) = interp_0( qv, pd_in, p_level, nl_in )
+      grid%t_1(i,k,j)          = interp_0( theta, pd_in, p_level, nl_in ) - t0
       grid%t_2(i,k,j)          = grid%t_1(i,k,j)
       
@@ -698 +694 @@
     DO K = 1, kte-1
       p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top
-      grid%v_1(i,k,j) = interp_0_log( v, p_in, p_level, nl_in )
+      grid%v_1(i,k,j) = interp_0( v, p_in, p_level, nl_in )
       grid%v_2(i,k,j) = grid%v_1(i,k,j)
     ENDDO
@@ -722 +718 @@
     DO K = 1, kte-1
       p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top
-      grid%u_1(i,k,j) = interp_0_log( u, p_in, p_level, nl_in )
+      grid%u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in )
       grid%u_2(i,k,j) = grid%u_1(i,k,j)
     ENDDO
@@ -851 +847 @@
       DO k=1,kte-1
          p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
-         scalar(its:ite,k,jts:jte,2) = interp_0_log( qv, pd_in, p_level, nl_in )
+         scalar(its:ite,k,jts:jte,2) = interp_0( qv, pd_in, p_level, nl_in )
          scalar(its:ite,k,jts:jte,3) = 0.
            !! water ice is set to 0 (was put into water vapor when building prof from MCD)
@@ -866 +862 @@
       DO k=1,kte-1
          p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
-         scalar(its:ite,k,jts:jte,4) = interp_0_log( profdustq, pd_in, p_level, nl_in )
-         scalar(its:ite,k,jts:jte,5) = interp_0_log( profdustn, pd_in, p_level, nl_in )
+         scalar(its:ite,k,jts:jte,4) = interp_0( profdustq, pd_in, p_level, nl_in )
+         scalar(its:ite,k,jts:jte,5) = interp_0( profdustn, pd_in, p_level, nl_in )
       ENDDO
       print *, "DUST Q", scalar(its,:,jts,4)
@@ -886 +882 @@
        DO i = its, ite
          !!! we use Q2 as a vehicle for heating rates! sick!
-         grid%m_q2(i,k,j) = interp_0_log( profdustq, pd_in, p_level, nl_in ) &
-                          + interp_0_log( profdustn, pd_in, p_level, nl_in )
+         grid%m_q2(i,k,j) = interp_0( profdustq, pd_in, p_level, nl_in ) &
+                          + interp_0( profdustn, pd_in, p_level, nl_in )
        ENDDO
        ENDDO
@@ -893 +889 @@
        !print*,k,grid%m_q2(1,k,1)
     ENDDO
-
+    print*,'planet',planet   
     IF (planet.eq."prescribed") Then
-      call read_hr(hrsw,hrlw,hrdyn,nl_in)
+      call read_hr(profdustq,profdustn,nl_in)
       open(unit=17,file="prescribed_sw.txt",action="write")
       open(unit=18,file="prescribed_lw.txt",action="write")
-      open(unit=19,file="prescribed_dyn.txt",action="write")
       DO k=1,kte!-1
         p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
-        prescribed_sw(k) = interp_0_log( hrsw, pd_in, p_level, nl_in )
-        prescribed_lw(k) = interp_0_log( hrlw, pd_in, p_level, nl_in )
-        prescribed_dyn(k) = interp_0_log( hrdyn, pd_in, p_level, nl_in )
+        prescribed_sw(k) = interp_0( profdustq, pd_in, p_level, nl_in )
+        prescribed_lw(k) = interp_0( profdustn, pd_in, p_level, nl_in )
         write (17,*) prescribed_sw(k)
         write (18,*) prescribed_lw(k)
-        write (19,*) prescribed_dyn(k)
       ENDDO
-      close(unit=19)
+      close(unit=17)
       close(unit=18)
-      close(unit=17)
     ENDIF
-    
-    IF (planet.eq."venus") Then
-      call read_hr(hrsw,hrlw,hrdyn,nl_in)
-      open(unit=20,file="venus_hrdyn.txt",action="write")
-      DO k=1,kte!-1
-        p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
-        venus_hrdyn(k) = interp_0_log( hrdyn, pd_in, p_level, nl_in )
-        write (20,*) venus_hrdyn(k)
-      ENDDO
-      close(unit=20)
-    ENDIF
-
-    open(unit=21,file="altitude.txt",action="write")
-    DO k=1,kte!-1
-      p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top
-      altitude(k) = interp_0_log( zk, pd_in, p_level, nl_in )
-      write (21,*) altitude(k)
-    ENDDO
-    close(unit=21)
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -968 +941 @@
 !---------------------------------------------------------------------------
 
-      subroutine get_sounding( zk, p, p_dry, theta, Tz, rho, &
+      subroutine get_sounding( zk, p, p_dry, theta, rho, &
                                u, v, qv, dry, nl_max, nl_in )
       implicit none
@@ -974 +947 @@
       integer nl_max, nl_in
       real zk(nl_max), p(nl_max), theta(nl_max), rho(nl_max), &
-           u(nl_max), v(nl_max), qv(nl_max), p_dry(nl_max),Tz(nl_max)
+           u(nl_max), v(nl_max), qv(nl_max), p_dry(nl_max)
       logical dry
 
@@ -1139 +1112 @@
           v(k) = v_input(k)
           qv(k) = qv_input(k)
-          Tz(k) = t_therm(k)
 
         enddo
@@ -1226 +1198 @@
       implicit none
       integer n
-      real pdustq(n+1),pdustn(n+1)
+      real pdustq(n),pdustn(n)
       logical end_of_file
 
@@ -1251 +1223 @@
       end subroutine read_dust
 !!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
-      subroutine read_hr(hr_sw,hr_lw,hr_dyn,n)
+      subroutine read_hr(hr_sw,hr_lw,n)
       implicit none
       integer n
-      real hr_sw(n+1),hr_lw(n+1),hr_dyn(n+1)
+      real hr_sw(n),hr_lw(n)
       logical end_of_file
 
@@ -1267 +1239 @@
       do while (.not. end_of_file)
 
-        read(11,*,end=103) hr_sw(k+1),hr_lw(k+1),hr_dyn(k+1)
-        write(*,*) k,hr_sw(k+1),hr_lw(k+1),hr_dyn(k+1)
+        read(11,*,end=103) hr_sw(k+1),hr_lw(k+1)
+        write(*,*) k,hr_sw(k+1),hr_lw(k+1)
         k = k+1
-        go to 114
+        go to 113
  103    end_of_file = .true.
  114    continue