Commit e9bd0bd6 authored by ldemaine's avatar ldemaine
Browse files

Initial commit

parents
This diff is collapsed.
program test_mcd
! ---------------------------------------------------------
! This is a simple program used to test and give an example
! of the call to the main mcd subroutine "call_mcd".
! ---------------------------------------------------------
implicit none
character choice_date*1
integer month,day,year,hour,minute,second ! for Earth date input
real ls ! for user input of Ls (if using "martian time")
integer i
!ccccccccccccc CALL_MCD arguments ccccccccccccccccccccccccccccccccccccccccccccc
! inputs:
integer zkey ! flag to choose the type of z coordinates
real xz ! value of the z coordinate
real xlon ! east longitude (degrees)
real xlat ! north latitude (degrees)
integer hireskey ! high resolution flag (0: off, 1: on)
integer datekey ! date flag (0: Earth date 1: Mars date)
double precision xdate ! Julian date (if datekey=0) or
! solar longitude Ls (if datekey=1)
real localtime ! local time at longitude xlon (only if datekey=1)
character(len=100) :: dset=" " ! path to MCD datasets; unset here
! (ie: defaults to "MCD_DATA/")
integer dust ! dust and solar EUV scenario
integer perturkey ! perturbation type
real seedin ! random generator seed and flag (if perturkey=1,2,3 or 4)
! coefficient to multiply std. dev. by (if perturkey=5)
real gwlength ! Gravity wave wavelength (needed if perturkey=3 or 4)
integer extvarkeys(100) ! extra output variables (1: yes, 0: no)
! outputs:
real pres ! atmospheric pressure
real ro ! atmospheric density
real temp ! atmospheric temperature
real u ! zonal wind
real v ! meridional wind
real meanvar(5) ! unperturbed values of main meteorological variables
real extvar(100) ! extra output variables
real seedout ! current value of random generator seed index
integer ier ! call_mcd status (=0 if all went well)
!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
! TIME
write(*,*) 'Do you want to use Earth date (e) or Mars date (m) ?'
888 continue
read(*,fmt='(a)') choice_date
write(*,*) choice_date
if (choice_date.eq.'e') then ! Earth date
datekey=0
localtime=0. !compulsary with earth date
write(*,*)'enter date : day month year hour minute second'
read (*,*) day,month,year,hour,minute,second
write(*,'(t2,i2,t4,a1,t5,i2,t7,a1,t8,i4,t14,i2,t16,a1,t17,i2,
& t19,a1,t20,i2)')
& day,'/',month,'/',year,hour,':',minute,':',second
call julian(month,day,year,hour,minute,second,ier,xdate)
write(*,'(''date, in Julian days : '',f16.8)') xdate
else if (choice_date.eq.'m') then ! Mars date
datekey=1
write(*,*)'enter solar longitude Ls (deg)'
read(*,*) ls
write(*,*)'mars local time (0 < local time < 24) ?'
read(*,*) localtime
xdate=ls
else
goto 888
end if
! LOCATION
write(*,*)'choose your type for vertical coordinates:'
write(*,*)'1 radius from center of planet (in meters )'
write(*,*)'2 height above areoid (in meters )'
write(*,*)'3 height above the surface (in meters )'
write(*,*)'4 pressure level (in Pa )'
read(*,*) zkey
write(*,'(i1)') zkey
if (zkey.eq.1) then
write(*,*) 'please enter the radius from center of planet (m)'
elseif (zkey.eq.2) then
write(*,*) 'please enter height above areoid (m)'
elseif (zkey.eq.3) then
write(*,*) 'please enter height above surface (m)'
elseif (zkey.eq.4) then
write(*,*) 'please enter the pressure level in Pa'
endif
read(*,*) xz
write(*,'(f10.3)') xz
! set hires flag
write(*,*) ' high resolution? (1: yes, 0: no)'
read(*,*) hireskey
write(*,'(i1)') hireskey
write(*,*)'latitude in deg ?'
read(*,*) xlat
write(*,'(f10.3)') xlat
write(*,*)'EAST longitude in deg ?'
read(*,*)xlon
write(*,'(f10.3)') xlon
! DUST scenario
write(*,*)'dust scenarios ?'
write(*,*)'1= Climatology typical Mars year dust scenario'
write(*,*)' average solar EUV conditions'
write(*,*)'2= Climatology typical Mars year dust scenario'
write(*,*)' minimum solar EUV conditions'
write(*,*)'3= Climatology typical Mars year dust scenario '
write(*,*)' maximum solar EUV conditions'
write(*,*)'4= dust storm constant dust opacity = 5'
write(*,*)' min solar EUV conditions'
write(*,*)'5= dust storm constant dust opacity = 5'
write(*,*)' ave solar EUV conditions'
write(*,*)'6= dust storm constant dust opacity = 5'
write(*,*)' max solar EUV conditions'
write(*,*)'7= warm scenario warm scenario: dustier conditions'
write(*,*)' max solar EUV conditions'
write(*,*)'8= cold scenario cold scenario: clearer conditions'
write(*,*)' min solar EUV conditions'
read(*,*)dust
write(*,'(i1)') dust
write(*,*)' perturbation : none = 1 ; large scale = 2 ;'
& ,' small scale= 3 ; small+large = 4 ; n sig =5'
read(*,*)perturkey
write(*,'(i1)') perturkey
write(*,*)' seedin and gwlength:'
read(*,*)seedin,gwlength
write(*,'(f10.0,f10.2)') seedin,gwlength
write(*,*)'extra variables : yes = 1, no = 0'
read(*,*)extvarkeys(1)
write(*,'(i1)')extvarkeys(1)
write(*,'(a1)') ' '
do i=2,100
! propagate extvarkeys(1) to extvarkeys(:)
extvarkeys(i)=extvarkeys(1)
enddo
! You can call call_mcd in a loop for a vertical profile,
! by just changing the value of xz at each iteration before
! the call call_mcd() below.
call call_mcd(zkey,xz,xlon,xlat,hireskey,
& datekey,xdate,localtime,dset,dust,
& perturkey,seedin,gwlength,extvarkeys,
& pres,ro,temp,u,v,meanvar,extvar,seedout,ier)
if (ier.eq.0) then
write(*,'(''p = '',1pe12.2,'' Pa'')') pres
write(*,'(''rho = '',1pe12.2,'' kg/m**3'')') ro
write(*,'(''T = '',1pe12.2,'' K'')') temp
write(*,'(''Zonal wind = '',1pe12.2,'' m/s'')') u
write(*,'(''Meridional wind = '',1pe12.2,'' m/s'')') v
write(*,'(a1)') ' '
do i=1,5
write(*,'(''meanvar('',i2,'') = '',1pe12.2)') i,meanvar(i)
end do
write(*,'(a1)') ' '
if(extvarkeys(1).ne.0) then
do i = 1,80 ! write all 80 extra variables
write(*,'(''extvar('',i2,'') = '',1pe12.2)') i,extvar(i)
enddo
else ! write the first 7 extvar()
do i=1,7
write(*,'(''extvar('',i2,'') = '',1pe12.2)') i,extvar(i)
enddo
end if
else
write(*,*)'CALL_MCD ERROR !!'
write(*,*)' returned error code: ', ier
end if
end
program test_slopes
implicit none
character choice_date*1
real ls ! for user input of Ls (if using "martian time")
!ccccccccccccc CALL_MCD arguments ccccccccccccccccccccccccccccccccccccccccccccc
! inputs:
integer zkey ! flag to choose the type of z coordinates
real xz ! value of the z coordinate
real xlon ! east longitude (degrees)
real xlat ! north latitude (degrees)
integer hireskey ! high resolution flag (0: off, 1: on)
integer datekey ! date flag (0: Earth date 1: Mars date)
double precision xdate ! Julian date (if datekey=0) or
! solar longitude Ls (if datekey=1)
real localtime ! local time at longitude xlon (only if datekey=1)
character(len=100) :: dset=" " ! path to MCD datasets; unset here
! (ie: defaults to "MCD_DATA/")
integer dust ! dust and solar EUV scenario
integer perturkey ! perturbation type
real seedin ! random generator seed and flag (if perturkey=1,2,3 or 4)
! coefficient to multiply std. dev. by (if perturkey=5)
real gwlength ! Gravity wave wavelength (needed if perturkey=3 or 4)
integer extvarkeys(100) ! extra output variables (1: yes, 0: no)
! outputs:
real pres ! atmospheric pressure
real ro ! atmospheric density
real temp ! atmospheric temperature
real u ! zonal wind
real v ! meridional wind
real meanvar(5) ! unperturbed values of main meteorological variables
real extvar(100) ! extra output variables
real seedout ! current value of random generator seed index
integer ier ! call_mcd status (=0 if all went well)
!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c$$$! Inputs
c$$$ character(len=100) :: dset="MCD_DATA/" ! path to MCD datasets; unset here
c$$$ real latitude ! north latitude (degrees)
c$$$ real longitude ! east longitude (degrees)
c$$$ real distance ! Distance from central point
c$$$ real zradius
c$$$
c$$$! Outputs
c$$$ real theta_s
c$$$ real psy_s
c$$$ integer :: ier ! returned status code (==0 if OK)
datekey = 1
ls = 0
localtime = 6.162
xdate = ls
zkey = 3
xz = 0.
hireskey = 1
xlat = -0.87
xlon = -72.57
dust = 1
perturkey = 1
seedin = 0.
gwlength = 0.
extvarkeys(:)=0
extvarkeys(79)=1
extvarkeys(80)=1
call call_mcd(zkey,xz,xlon,xlat,hireskey,
& datekey,xdate,localtime,dset,dust,
& perturkey,seedin,gwlength,extvarkeys,
& pres,ro,temp,u,v,meanvar,extvar,seedout,ier)
write(*,*) 'xlon, xlat'
write(*,*) xlon, xlat
write(*,*) '--------------------------------------------------'
write(*,*) 'theta_s',extvar(79)
write(*,*) 'psy_s',extvar(80)
write(*,*) 'Ftot',extvar(81)
end
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment