Commit be8f8e2f authored by ph290's avatar ph290
Browse files

changed default to gfortran so only supporting one version

parent fba7a713
......@@ -23,6 +23,8 @@
!
!***************************************************************************************!
!
MODULE physics
implicit none
double precision :: lon,lat,kb,f0,f1,lambda,heat_shade,vismax,qsdt,stressx,stressy,windspeed,polarisn(6),rad_out, &
......@@ -30,7 +32,8 @@ MODULE physics
first_temp,sx,sy,radsum,omega(5),major_phase(5),background_mol,u_bed,v_bed,speed_mag(200),mean_speed, &
rad0,speed,speed1,speed2,speed3,time,depth,newdepth,grav_accel,radiation_zerocloud(40000),radiation_fullcloud(40000), &
uac,uc,gac1,gac2,gac,gc1,gc2,gc,strat_jul,rad_sum,acount
DOUBLE PRECISION :: wind_speed(40000),wind_dir(40000),std_dir(40000),std_speed(40000),radiation(40000),humid(40000),airP(40000),airT(40000), &
DOUBLE PRECISION :: wind_speed(40000),wind_dir(40000),std_dir(40000),std_speed(40000),&
radiation(40000),humid(40000),airP(40000),airT(40000), &
cloud(40000),declination(40000)
real :: tid,tid2,uamp(5),vamp(5),vphase(5),uphase(5)
integer :: idmet,iday_front1,iday_front2,iday_front3,iday_front4
......@@ -74,6 +77,83 @@ MODULE file_names
character(len=100) :: metfile_in,surface_out,phys_profile_day,phys_profile_hour, &
bio_profile_day,bio_profile_hour,initialdata,monthly_out,user_metfile
END MODULE
! --------------------------------------------------------------------
! MODULE MyTrigonometricFunctions:
! This module provides the following functions and constants
! (1) RadianToDegree() - converts its argument in radian to
! degree
! (2) DegreeToRadian() - converts its argument in degree to
! radian
! (3) MySIN() - compute the sine of its argument in
! degree
! (4) MyCOS() - compute the cosine of its argument
! in degree
! --------------------------------------------------------------------
MODULE MyTrigonometricFunctions
implicit none
REAL(8), PARAMETER :: PI = 3.1415926
REAL(8), PARAMETER :: Degree180 = 180.0
REAL(8), PARAMETER :: R_to_D = Degree180/PI
REAL(8), PARAMETER :: D_to_R = PI/Degree180
CONTAINS
! --------------------------------------------------------------------
! FUNCTION RadianToDegree():
! This function takes a REAL argument in radian and converts it to
! the equivalent degree.
! --------------------------------------------------------------------
REAL FUNCTION RadianToDegree(Radian)
IMPLICIT NONE
REAL(8), INTENT(IN) :: Radian
RadianToDegree = Radian * R_to_D
END FUNCTION RadianToDegree
! --------------------------------------------------------------------
! FUNCTION DegreeToRadian():
! This function takes a REAL argument in degree and converts it to
! the equivalent radian.
! --------------------------------------------------------------------
REAL FUNCTION DegreeToRadian(Degree)
IMPLICIT NONE
REAL(8), INTENT(IN) :: Degree
DegreeToRadian = Degree * D_to_R
END FUNCTION DegreeToRadian
! --------------------------------------------------------------------
! FUNCTION MySIN():
! This function takes a REAL argument in degree and computes its
! sine value. It does the computation by converting its argument to
! radian and uses Fortran's sin().
! --------------------------------------------------------------------
REAL FUNCTION MySIN(x)
IMPLICIT NONE
REAL(8), INTENT(IN) :: x
MySIN = SIN(DegreeToRadian(x))
END FUNCTION MySIN
! --------------------------------------------------------------------
! FUNCTION MySIN():
! This function takes a REAL argument in degree and computes its
! cosine value. It does the computation by converting its argument to
! radian and uses Fortran's cos().
! --------------------------------------------------------------------
REAL FUNCTION MyCOS(x)
IMPLICIT NONE
REAL(8), INTENT(IN) :: x
MyCOS = COS(DegreeToRadian(x))
END FUNCTION MyCOS
END MODULE MyTrigonometricFunctions
!
MODULE VARIABLES
!
......@@ -130,12 +210,12 @@ END MODULE GRAPHICS_VARIABLES
MODULE INTERFACES
IMPLICIT NONE
INTERFACE
SUBROUTINE ProcessMenu(IDENT,QUIT,unique_job_id)
SUBROUTINE ProcessMenu2(IDENT,QUIT,unique_job_id)
IMPLICIT NONE
INTEGER, INTENT(IN ) :: IDENT
LOGICAL, INTENT(IN OUT) :: QUIT
character(len=36) :: unique_job_id
END SUBROUTINE ProcessMenu
END SUBROUTINE ProcessMenu2
!
SUBROUTINE About()
IMPLICIT NONE
......@@ -185,13 +265,27 @@ END MODULE GRAPHICS_VARIABLES
character(len=36) :: unique_job_id
character(len=300) :: met_data_location
real :: woa_nutrient
INTEGER :: include_depth_output,include_temp_surface_output,include_temp_bottom_output,include_chlorophyll_surface_output,include_phyto_biomass_surface_output,include_phyto_biomass_bottom_output,include_PAR_surface_output,include_PAR_bottom_output,include_windspeed_output,include_stressx_output,include_stressy_output,include_Etide_output,include_Ewind_output,include_u_mean_surface_output,include_u_mean_bottom_output,include_grow1_mean_surface_output,include_grow1_mean_bottom_output,include_uptake1_mean_surface_output,include_uptake1_mean_bottom_output,include_tpn1_output,include_tpg1_output,include_speed3_output
INTEGER :: include_depth_output,include_temp_surface_output,include_temp_bottom_output,&
include_chlorophyll_surface_output,include_phyto_biomass_surface_output,&
include_phyto_biomass_bottom_output,include_PAR_surface_output,include_PAR_bottom_output,&
include_windspeed_output,include_stressx_output,include_stressy_output,include_Etide_output,&
include_Ewind_output,include_u_mean_surface_output,include_u_mean_bottom_output,&
include_grow1_mean_surface_output,include_grow1_mean_bottom_output,&
include_uptake1_mean_surface_output,include_uptake1_mean_bottom_output,include_tpn1_output,&
include_tpg1_output,include_speed3_output
!
! Initialise Winteracter
!
! print*, 'getting physics defaults'
call get_physics_defaults(lat_in_domain,lon_in_domain,run_year,start_year,unique_job_id,met_data_location,iline,woa_nutrient,include_depth_output,include_temp_surface_output,include_temp_bottom_output,include_chlorophyll_surface_output,include_phyto_biomass_surface_output,include_phyto_biomass_bottom_output,include_PAR_surface_output,include_PAR_bottom_output,include_windspeed_output,include_stressx_output,include_stressy_output,include_Etide_output,include_Ewind_output,include_u_mean_surface_output,include_u_mean_bottom_output,include_grow1_mean_surface_output,include_grow1_mean_bottom_output,include_uptake1_mean_surface_output,include_uptake1_mean_bottom_output,include_tpn1_output,include_tpg1_output,include_speed3_output)
call get_physics_defaults(lat_in_domain,lon_in_domain,run_year,start_year,unique_job_id,&
met_data_location,iline,woa_nutrient,include_depth_output,include_temp_surface_output,&
include_temp_bottom_output,include_chlorophyll_surface_output,include_phyto_biomass_surface_output,&
include_phyto_biomass_bottom_output,include_PAR_surface_output,include_PAR_bottom_output,&
include_windspeed_output,include_stressx_output,include_stressy_output,include_Etide_output,&
include_Ewind_output,include_u_mean_surface_output,include_u_mean_bottom_output,&
include_grow1_mean_surface_output,include_grow1_mean_bottom_output,include_uptake1_mean_surface_output,&
include_uptake1_mean_bottom_output,include_tpn1_output,include_tpg1_output,include_speed3_output)
depth=newdepth; N=newN; dz=newdz
! print*, 'getting phyto defaults'
call get_phyto_defaults()
......@@ -205,7 +299,8 @@ END MODULE GRAPHICS_VARIABLES
! read(5,*) met_type
! print*, 'getting met'
call get_met(lat_in_domain,lon_in_domain,run_year,start_year,unique_job_id,met_data_location,iline)
surface_out='surface'//unique_job_id//'.dat'; phys_profile_day='physday.dat'; bio_profile_day='biolday.dat'; monthly_out='monthly'//unique_job_id//'.dat'
surface_out='surface'//unique_job_id//'.dat'; phys_profile_day='physday.dat'; bio_profile_day='biolday.dat';&
monthly_out='monthly'//unique_job_id//'.dat'
phys_profile_hour='physhour.dat'; bio_profile_hour='biolhour.dat'
metfile_in='Model default meteorological data'
user_metfile=''
......@@ -244,19 +339,33 @@ END MODULE GRAPHICS_VARIABLES
integer nhu3a,nhu3b
INTEGER, INTENT (IN) :: IDENT
LOGICAL, INTENT (IN OUT) :: QUIT
character(len=4) :: run_year,start_year,iline
! character(len=4) :: run_year,start_year,iline
INTEGER :: run_year,start_year,iline
character(len=12) :: lat_in_domain
character(len=12) :: lon_in_domain
character(len=36) :: unique_job_id
character(len=300) :: met_data_location
real :: woa_nutrient
INTEGER :: include_depth_output,include_temp_surface_output,include_temp_bottom_output,include_chlorophyll_surface_output,include_phyto_biomass_surface_output,include_phyto_biomass_bottom_output,include_PAR_surface_output,include_PAR_bottom_output,include_windspeed_output,include_stressx_output,include_stressy_output,include_Etide_output,include_Ewind_output,include_u_mean_surface_output,include_u_mean_bottom_output,include_grow1_mean_surface_output,include_grow1_mean_bottom_output,include_uptake1_mean_surface_output,include_uptake1_mean_bottom_output,include_tpn1_output,include_tpg1_output,include_speed3_output
INTEGER :: include_depth_output,include_temp_surface_output,include_temp_bottom_output,&
include_chlorophyll_surface_output,include_phyto_biomass_surface_output,include_phyto_biomass_bottom_output,&
include_PAR_surface_output,include_PAR_bottom_output,include_windspeed_output,include_stressx_output,&
include_stressy_output,include_Etide_output,include_Ewind_output,include_u_mean_surface_output,&
include_u_mean_bottom_output,include_grow1_mean_surface_output,include_grow1_mean_bottom_output,&
include_uptake1_mean_surface_output,include_uptake1_mean_bottom_output,include_tpn1_output,&
include_tpg1_output,include_speed3_output
!
! Branch depending on chosen menu item
!
call save_work(lat_in_domain,lon_in_domain,run_year,start_year,unique_job_id,met_data_location,iline,woa_nutrient,include_depth_output,include_temp_surface_output,include_temp_bottom_output,include_chlorophyll_surface_output,include_phyto_biomass_surface_output,include_phyto_biomass_bottom_output,include_PAR_surface_output,include_PAR_bottom_output,include_windspeed_output,include_stressx_output,include_stressy_output,include_Etide_output,include_Ewind_output,include_u_mean_surface_output,include_u_mean_bottom_output,include_grow1_mean_surface_output,include_grow1_mean_bottom_output,include_uptake1_mean_surface_output,include_uptake1_mean_bottom_output,include_tpn1_output,include_tpg1_output,include_speed3_output)
call save_work(lat_in_domain,lon_in_domain,run_year,start_year,unique_job_id,met_data_location,&
iline,woa_nutrient,include_depth_output,include_temp_surface_output,include_temp_bottom_output,&
include_chlorophyll_surface_output,include_phyto_biomass_surface_output,&
include_phyto_biomass_bottom_output,include_PAR_surface_output,include_PAR_bottom_output,&
include_windspeed_output,include_stressx_output,include_stressy_output,include_Etide_output,&
include_Ewind_output,include_u_mean_surface_output,include_u_mean_bottom_output,&
include_grow1_mean_surface_output,include_grow1_mean_bottom_output,include_uptake1_mean_surface_output,&
include_uptake1_mean_bottom_output,include_tpn1_output,include_tpg1_output,include_speed3_output)
deallocate (contour_data,xdata,ydata,profile,au,bu,cu,du,ru,qu,tke,tkeold,eps)
!
! Open required files for results, and write headers
......@@ -329,7 +438,8 @@ END MODULE GRAPHICS_VARIABLES
include_grow1_mean_surface_output,include_grow1_mean_bottom_output,include_uptake1_mean_surface_output,&
include_uptake1_mean_bottom_output,include_tpn1_output,include_tpg1_output,include_speed3_output)
surface_out='surface'//unique_job_id//'.dat'; phys_profile_day='physday.dat'; bio_profile_day='biolday.dat'; monthly_out='monthly'//unique_job_id//'.dat'
surface_out='surface'//unique_job_id//'.dat'; phys_profile_day='physday.dat'; bio_profile_day='biolday.dat';&
monthly_out='monthly'//unique_job_id//'.dat'
close(21)
if(output_end.gt.0.0)close(22)
......@@ -793,7 +903,7 @@ Subroutine physics_input() ! Get physics driving parameters
!
! Load and show the modal dialog
!
call get_physics_defaults()
! call get_physics_defaults()
call tide_parameters(1)
!
! Calculate ellipse parameters
......@@ -1149,6 +1259,7 @@ Subroutine grazing() ! Get phytoplankton grazing parameters
use physics
use variables
use file_names
use MyTrigonometricFunctions
IMPLICIT NONE
integer :: i,idum
......@@ -1174,7 +1285,8 @@ Subroutine grazing() ! Get phytoplankton grazing parameters
airT(i)=12.5-3.3*cos(real(i)*0.017214191)-2.5*sin(real(i)*0.017214191)
airP(i)=1016.0 !*(1.014-0.0004*cos(real(i)*0.017214191)+0.0009*sin(real(i)*0.017214191))
day_angle=360.0*real(i)/real(ndays)
declination(i)=0.39637-22.9133*dcosd(day_angle)+4.02543*dsind(day_angle)-0.3872*dcosd(2.0*day_angle)+0.052*dsind(2.0*day_angle)
declination(i)=0.39637-22.9133*MyCOS(day_angle)+4.02543*MySIN(day_angle)-0.3872*MyCOS(2.0*day_angle)&
+0.052*MySIN(2.0*day_angle)
cloud(i)=66.5+5.1*cos(real(i)*0.017214191)-4.1*sin(real(i)*0.017214191) !100.0*(0.15*cos(real(i)*0.017214191)+0.65)
write(60,fmt="(i4,6f10.2)") i,wind_speed(i),wind_dir(i),cloud(i),airT(i),airP(i),humid(i)
! print*, i,wind_speed(i),wind_dir(i),cloud(i),airT(i),airP(i),humid(i)
......@@ -1186,7 +1298,8 @@ Subroutine grazing() ! Get phytoplankton grazing parameters
write(run_year_str,3001) run_year
3001 format (I4)
! open(60,file=fileplace//"meterological_datalat"//TRIM(ADJUSTL(lat_in_domain))//"lon"//TRIM(ADJUSTL(lon_in_domain))//"_"//run_year_str//".dat",status='old')
open(60,file=TRIM(ADJUSTL(met_data_location))//"meterological_datalat"//TRIM(ADJUSTL(lat_in_domain))//"lon"//TRIM(ADJUSTL(lon_in_domain))//"_"//run_year_str//".dat",status='old')
open(60,file=TRIM(ADJUSTL(met_data_location))//"meterological_datalat"//TRIM(ADJUSTL(lat_in_domain))&
//"lon"//TRIM(ADJUSTL(lon_in_domain))//"_"//run_year_str//".dat",status='old')
i=1
......@@ -1207,7 +1320,8 @@ Subroutine grazing() ! Get phytoplankton grazing parameters
do i=1,ndays
day_angle=(360.0*dble(i)/dble(ndays)) * (dble(ndays)/365.0)
!The change in the line above alows for simulations longer than 1 year, but assumes all years are 365 days long.
declination(i)=0.39637-22.9133*dcosd(day_angle)+4.02543*dsind(day_angle)-0.3872*dcosd(2.0*day_angle)+0.052*dsind(2.0*day_angle)
declination(i)=0.39637-22.9133*MyCOS(day_angle)+4.02543*MySIN(day_angle)-0.3872*&
MyCOS(2.0*day_angle)+0.052*MySIN(2.0*day_angle)
end do
end if
......@@ -1291,6 +1405,7 @@ Subroutine grazing() ! Get phytoplankton grazing parameters
use turbulence
use file_names
use graphics_variables
use MyTrigonometricFunctions
implicit none
......@@ -1327,6 +1442,22 @@ Subroutine grazing() ! Get phytoplankton grazing parameters
u_cubed=0.0; n_cubed=0
N=newN; depth=newdepth; dz=newdz
! map output
if(imode.eq.1) then
! avoid shallow and deep ocean
if(depth.lt.5.0.or.depth.gt.150.0) then
iday = 0
strat_jul = -999.99
timeloop_init: do itime=0,ndays
write(6,fmt="(i4,2f9.3,4f8.2)")iday,lon,lat,depth,strat_jul,strat_jul,strat_jul
iday=iday+1
END do timeloop_init
go to 999
!the go to 999 jumps to 999 continue, so skip the main routine for these water depth, just writing out missing data
endif
endif
!
! Allocate graphics and turbulence arrays
!
......@@ -1347,7 +1478,8 @@ x_old(1:200)=0.1; ni_old(1:200)=0.1; ni_old(1:200)=0.1; s_old(1:200)=bed_din; x_
ni_new(1:200)=0.1; x_new(1:200)=0.1
x_old(1:200)=x_new(1:200); ni_new(1:200)=0.1; s_new(1:200)=bed_din
tpn1=0.0; tpn2=0.0; tpg1=0.0; tpg2=0.0; total_flux=0.0
hourly_net=0.0; hourly_gross=0.0; accumulated=0.0; daily_net=0.0; daily_gross=0.0; prod_net=0.0; prod_gross=0.0; prod_net_daily=0.0; prod_gross_daily=0.0
hourly_net=0.0; hourly_gross=0.0; accumulated=0.0; daily_net=0.0; daily_gross=0.0; prod_net=0.0; &
prod_gross=0.0; prod_net_daily=0.0; prod_gross_daily=0.0
total_uptake=0.0; surf_uptake=0.0
call bio_rates() ! This changes the daily bio rates into per sec
......@@ -1380,7 +1512,7 @@ month_tb=0.0; month_stress=0.0
f0=(4.0*3.142/(24.0*3600.0))*dsin(lat*3.142/180.0); f1=-f0 ! calculate Coriolis parameter.
alf=time_step*f0; alf1=1.0/(1.0+((alf**2.0)/4.0)); alf2=1.0-((alf**2.0)/4.0) ! constants used for semi-implicit Coriolis
parmax=real(int(1368.0*0.76*sind(abs(lat))*(1.0-0.06)*par_percent*DEXP(-(dz/2.0)*par_atten)))
parmax=real(int(1368.0*0.76*MySIN(abs(lat))*(1.0-0.06)*par_percent*DEXP(-(dz/2.0)*par_atten)))
velmax=REAL(INT(100.0*(sqrt(sum(semi_major(1:5)**2.0))))) ! max velocity for screen plot
idmet=1 ! counter for meteorology arrays
......@@ -1513,7 +1645,7 @@ timeloop: do itime=1,itotal ! <A NAME="START OF TIME LOOP">
noon_time=dble(idmet-1)+0.5
day_time=(time/(24.0*3600.0))-noon_time
day_angle=(2.0*3.1415927)*day_time
sin_solar_elev=dcos(day_angle)*dcosd(lat)*dcosd(declination(idmet))+dsind(lat)*dsind(declination(idmet))
sin_solar_elev=dcos(day_angle)*MyCOS(lat)*MyCOS(declination(idmet))+MySIN(lat)*MySIN(declination(idmet))
rad_ideal=1368.0*0.76*sin_solar_elev*(1.0-0.06) ! clear sky irradiance W m-2
rad0=rad_ideal*(1.0-0.01*cloud(idmet)*0.4-0.000038*cloud(idmet)**2.0) ! irradiance with cloud
if(rad0.lt.0.0)rad0=0.0
......
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