Ignore:
Timestamp:
Sep 16, 2016, 3:05:48 PM (9 years ago)
Author:
mlefevre
Message:

In modif_mars : deleted planet specific modules. Added initialization module_model_constants. Implemented heating rates reading for prescribed planet.

Location:
trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2
Files:
2 edited

Legend:

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

    r1236 r1607  
    107107   INTEGER :: icm,jcm, ii, im1, jj, jm1, loop, error, fid, nxc, nyc
    108108   REAL    :: u_mean,v_mean, f0, p_surf, p_level, qvf, z_at_v, z_at_u
    109    REAL    :: z_scale, xrad, yrad, zrad, rad, delt, cof1, cof2
     109   REAL    :: xrad, yrad, zrad, rad, delt, cof1, cof2
    110110!   REAL, EXTERNAL :: interp_0
    111111   REAL    :: hm, xa
     
    129129 INTEGER :: ierr
    130130!!MARS
     131 REAL, DIMENSION(nl_max) :: profdustq,profdustn
     132 REAL, DIMENSION(nl_max) :: prescribed_sw,prescribed_lw
    131133
    132134      REAL :: pfu, pfd, phm
     
    134136      !INTEGER :: hypsometric_opt = 2 ! Wee et al. 2012 correction
    135137
    136 
     138character(len=10) :: planet
    137139
    138140#ifdef DM_PARALLEL
     
    140142#endif
    141143
     144   call init_planet_constants
    142145
    143146   SELECT CASE ( model_data_order )
     
    878881  ENDDO
    879882  ENDDO
    880 
     883    IF (planet.eq."prescribed") Then
     884      call read_hr(profdustq,profdustn,nl_in)
     885      open(unit=17,file="prescribed_sw.txt",action="write")
     886      open(unit=18,file="prescribed_lw.txt",action="write")
     887      DO k=1,kte!-1
     888        p_level = grid%em_znu(k)*(pd_surf - grid%p_top) + grid%p_top
     889        prescribed_sw(k) = interp_0( profdustq, pd_in, p_level, nl_in )
     890        prescribed_lw(k) = interp_0( profdustn, pd_in, p_level, nl_in )
     891        write (17,*) prescribed_sw(k)
     892        write (18,*) prescribed_lw(k)
     893      ENDDO
     894      close(unit=17)
     895      close(unit=18)
     896    ENDIF
    881897 END SUBROUTINE init_domain_rk
    882898
     
    955971!      parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 )
    956972!      parameter (p1000mb = 610., r = 192., cp = 844.6, cv = cp-r, cvpm = -cv/cp, g=3.72)
    957       parameter (p1000mb = 610., r = 191., cp = 744.5, cv = cp-r, cvpm = -cv/cp, g=3.72)
     973!      parameter (p1000mb = 610., r = 191., cp = 744.5, cv = cp-r, cvpm = -cv/cp, g=3.72)
    958974!****Mars
    959975      integer k, it, nl
     
    9991015      qvf = 1. + rvovrd*qv_input(1)
    10001016      rho_surf = 1./((r/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm))
    1001       pi_surf = (p_surf/p1000mb)**(r/cp)
     1017      pi_surf = (p_surf/p1000mb)**(rcp)
    10021018          !!!!!! rcp variable
    10031019          !rho_surf =  1./((r_input(1)/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm_input(1)))
     
    10471063                      - dz*(0.75*rho_input(k)+0.25*rho_input(k-1))*g*qvf1
    10481064                      !- 0.5*dz*(rho_input(k)+rho_input(k-1))*g*qvf1
    1049               rho_input(k) = 1./((r/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm))
     1065              rho_input(k) = 1./((r_d/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm))
    10501066!!
    10511067!! marche pas
     
    11641180      end subroutine read_sounding
    11651181
     1182      subroutine read_hr(hr_sw,hr_lw,n)
     1183      implicit none
     1184      integer n
     1185      real hr_sw(n),hr_lw(n)
     1186      logical end_of_file
     1187
     1188      integer k
     1189
     1190! first element is the surface
     1191
     1192      open(unit=11,file='input_hr',form='formatted',status='old')
     1193      rewind(11)
     1194      end_of_file = .false.
     1195      k = 0
     1196      do while (.not. end_of_file)
     1197
     1198        read(11,*,end=102) hr_sw(k+1),hr_lw(k+1)
     1199        write(*,*) k,hr_sw(k+1),hr_lw(k+1)
     1200        k = k+1
     1201        go to 113
     1202 102    end_of_file = .true.
     1203 113    continue
     1204      enddo
     1205
     1206      close(unit=11,status = 'keep')
     1207
     1208      end subroutine read_hr
     1209
    11661210END MODULE module_initialize
  • TabularUnified trunk/MESOSCALE/LMD_MM_MARS/SRC/WRFV2/share/init_modules.F

    r11 r1607  
    5555 CALL init_module_configure
    5656 CALL init_module_driver_constants
    57  CALL init_module_model_constants
     57 CALL init_planet_constants
    5858 CALL init_module_domain
    5959 CALL init_module_machine
Note: See TracChangeset for help on using the changeset viewer.