Commit b7630082 authored by kbk's avatar kbk
Browse files

added support for Intel/IFORT compiler - expanded TABS, same types in subroutine calls

parent bb070be6
REALTYPE,dimension(:,:),allocatable :: D,DU,DV
REALTYPE,dimension(:,:),allocatable :: z,zo
REALTYPE,dimension(:,:),allocatable :: zu,zv
REALTYPE,dimension(:,:),allocatable :: U,V
REALTYPE,dimension(:,:),allocatable :: UEx,VEx
REALTYPE,dimension(:,:),allocatable :: fU,fV
REALTYPE,dimension(:,:),allocatable :: ru,rv
REALTYPE,dimension(:,:),allocatable :: Uint,Vint
REALTYPE,dimension(:,:),allocatable :: Uinto,Vinto
REALTYPE,dimension(:,:),allocatable :: res_du,res_u
REALTYPE,dimension(:,:),allocatable :: res_dv,res_v
REALTYPE,dimension(:,:),allocatable :: D,DU,DV
REALTYPE,dimension(:,:),allocatable :: z,zo
REALTYPE,dimension(:,:),allocatable :: zu,zv
REALTYPE,dimension(:,:),allocatable :: U,V
REALTYPE,dimension(:,:),allocatable :: UEx,VEx
REALTYPE,dimension(:,:),allocatable :: fU,fV
REALTYPE,dimension(:,:),allocatable :: ru,rv
REALTYPE,dimension(:,:),allocatable :: Uint,Vint
REALTYPE,dimension(:,:),allocatable :: Uinto,Vinto
REALTYPE,dimension(:,:),allocatable :: res_du,res_u
REALTYPE,dimension(:,:),allocatable :: res_dv,res_v
!kbk
REALTYPE,dimension(:,:),allocatable :: ruu,rvv
REALTYPE,dimension(:,:),allocatable :: PP
REALTYPE,dimension(:,:),allocatable :: ruu,rvv
REALTYPE,dimension(:,:),allocatable :: PP
!kbk
REALTYPE,dimension(:,:),allocatable :: SlUx,SlVx
REALTYPE,dimension(:,:),allocatable :: Slru,Slrv
REALTYPE,dimension(:,:),allocatable :: zub,zvb
REALTYPE,dimension(:,:),allocatable :: zub0,zvb0
REALTYPE,dimension(:,:),allocatable :: surfdiv
REALTYPE,dimension(:,:),allocatable :: SlUx,SlVx
REALTYPE,dimension(:,:),allocatable :: Slru,Slrv
REALTYPE,dimension(:,:),allocatable :: zub,zvb
REALTYPE,dimension(:,:),allocatable :: zub0,zvb0
REALTYPE,dimension(:,:),allocatable :: surfdiv
REALTYPE,dimension(:), allocatable :: EWbdy,ENbdy,EEbdy,ESbdy
REALTYPE,dimension(:), allocatable:: EWbdy,ENbdy,EEbdy,ESbdy
! Remember to update this value if you add more 2D arrays.
integer, parameter :: n2d_fields=35
!$Id: update_2d_bdy.F90,v 1.3 2003-04-23 12:09:44 kbk Exp $
!$Id: update_2d_bdy.F90,v 1.4 2003-12-16 16:50:40 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -12,7 +12,7 @@
!
! !USES:
use domain, only: NWB,NNB,NEB,NSB,H,min_depth,imin,imax,jmin,jmax,az
use domain, only: wi,wfj,wlj,nj,nfi,nli,ei,efj,elj,sj,sfi,sli,nsbv
use domain, only: wi,wfj,wlj,nj,nfi,nli,ei,efj,elj,sj,sfi,sli
use domain, only: bdy_index,nsbv
use m2d, only: dtm,bdyfmt_2d,bdy_data
use variables_2d, only: z
......@@ -29,7 +29,10 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: update_2d_bdy.F90,v $
! Revision 1.3 2003-04-23 12:09:44 kbk
! Revision 1.4 2003-12-16 16:50:40 kbk
! added support for Intel/IFORT compiler - expanded TABS, same types in subroutine calls
!
! Revision 1.3 2003/04/23 12:09:44 kbk
! cleaned code + TABS to spaces
!
! Revision 1.2 2003/04/07 15:45:05 kbk
......@@ -72,6 +75,7 @@
REALTYPE, save :: t,t1,t2
REALTYPE :: a,amp,ratio,fac
integer :: i,j,k,l,n
REALTYPE, parameter :: FOUR=4.*_ONE_
!
!EOP
!-----------------------------------------------------------------------
......@@ -172,7 +176,7 @@
ratio = _ONE_
fac = _ONE_
if(bdyramp .gt. 1) fac=min( _ONE_ ,4.*loop/float(bdyramp))
if(bdyramp .gt. 1) fac=min( _ONE_ ,FOUR*loop/float(bdyramp))
l = 0
do n = 1,NWB
......
......@@ -49,7 +49,10 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: advection_3d.F90,v $
! Revision 1.4 2003-09-03 05:38:45 kbk
! Revision 1.5 2003-12-16 16:50:40 kbk
! added support for Intel/IFORT compiler - expanded TABS, same types in subroutine calls
!
! Revision 1.4 2003/09/03 05:38:45 kbk
! need to call update_3d_halo() for each directional split
!
! Revision 1.3 2003/04/23 12:16:34 kbk
......@@ -118,6 +121,7 @@
!
! !LOCAL VARIABLES:
integer :: advection_method
REALTYPE, parameter :: ONE=_ONE_,TWO=2.*_ONE_
!EOP
!-----------------------------------------------------------------------
......@@ -216,7 +220,7 @@
! See the log for the module
!
! !LOCAL VARIABLES:
REALTYPE, parameter :: a1=0.5,a2=1.0
REALTYPE, parameter :: a1=0.5*ONE,a2=ONE
!
!EOP
!-----------------------------------------------------------------------
......@@ -256,7 +260,7 @@
hor_adv,az,AH)
call update_3d_halo(f,f,az, &
iimin,jjmin,iimax,jjmax,kmax,D_TAG)
iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG)
call v_split_adv(dt,f,vv,hvn,delxv,delyv,area_inv,av,a1,&
......@@ -539,18 +543,18 @@
end if
select case (method)
case ((P2),(P2_PDM))
x = one6th*(1.-2.0*c)
x = one6th*(ONE-TWO*c)
Phi=(0.5+x)+(0.5-x)*r
if (method.eq.P2) then
limit=Phi
else
limit=max(_ZERO_,min(Phi,2./(1.-c), &
2.*r/(c+1.e-10)))
2.*r/(c+1.e-10)))
end if
case (Superbee)
limit=max(_ZERO_,min(1.0, 2.0*r),min(r,2.0))
limit=max(_ZERO_,min(ONE,TWO*r),min(r,TWO))
case (MUSCL)
limit=max(_ZERO_,min(2.0,2.0*r,0.5*(1.0+r)))
limit=max(_ZERO_,min(TWO,TWO*r,0.5*(ONE+r)))
case default
FATAL 'Not so good - do_advection_3d()'
stop 'u_split_adv'
......@@ -559,7 +563,7 @@
!Horizontal diffusion
if ( AH.gt.0. .and. az(i,j).gt.0 .and. az(i+1,j).gt.0 ) then
cu(i,j,k) = cu(i,j,k)-AH*hun(i,j,k) &
*(f(i+1,j,k)-f(i,j,k))/delxu(i,j)
*(f(i+1,j,k)-f(i,j,k))/delxu(i,j)
end if
end if
end do
......@@ -690,11 +694,11 @@
r=(fu-fc)*1.e10
end if
end if
x = one6th*(1.-2.0*c)
x = one6th*(ONE-TWO*c)
Phi=(0.5+x)+(0.5-x)*r
select case (method)
case ((P2),(P2_PDM))
x = one6th*(1.-2.0*c)
x = one6th*(ONE-TWO*c)
Phi=(0.5+x)+(0.5-x)*r
if (method.eq.P2) then
limit=Phi
......@@ -702,9 +706,9 @@
limit=max(_ZERO_,min(Phi,2./(1.-c),2.*r/(c+1.e-10)))
end if
case (Superbee)
limit=max(_ZERO_, min(1.0, 2.0*r), min(r,2.0) )
limit=max(_ZERO_, min(ONE,TWO*r), min(r,TWO) )
case (MUSCL)
limit=max(_ZERO_,min(2.0,2.0*r,0.5*(1.0+r)))
limit=max(_ZERO_,min(TWO,TWO*r,0.5*(ONE+r)))
case default
FATAL 'This is not so good - do_advection_3d()'
stop 'v_split_adv'
......@@ -837,11 +841,11 @@
r=(fu-fc)*1.e10
end if
end if
x = one6th*(1.-2.0*c)
x = one6th*(ONE-TWO*c)
Phi=(0.5+x)+(0.5-x)*r
select case (method)
case ((P2),(P2_PDM))
x = one6th*(1.-2.0*c)
x = one6th*(ONE-TWO*c)
Phi=(0.5+x)+(0.5-x)*r
if (method.eq.P2) then
limit=Phi
......@@ -849,9 +853,9 @@
limit=max(_ZERO_,min(Phi,2./(1.-c),2.*r/(c+1.e-10)))
end if
case (Superbee)
limit=max(_ZERO_, min(1.0, 2.0*r), min(r,2.0) )
limit=max(_ZERO_, min(ONE, TWO*r), min(r,TWO) )
case (MUSCL)
limit=max(_ZERO_,min(2.0,2.0*r,0.5*(1.0+r)))
limit=max(_ZERO_,min(TWO,TWO*r,0.5*(ONE+r)))
case default
FATAL 'This is not so good - do_advection_3d()'
stop 'w_split_adv'
......@@ -991,11 +995,11 @@
r= (fu-fc)*1.e10
end if
end if
x = one6th*(1.-2.0*c)
x = one6th*(ONE-TWO*c)
Phi=(0.5+x)+(0.5-x)*r
select case (method)
case ((P2),(P2_PDM))
x = one6th*(1.-2.0*c)
x = one6th*(ONE-TWO*c)
Phi=(0.5+x)+(0.5-x)*r
if (method.eq.P2) then
limit=Phi
......@@ -1003,9 +1007,9 @@
limit=max(_ZERO_,min(Phi,2./(1.-c),2.*r/(c+1.e-10)))
end if
case (Superbee)
limit=max(_ZERO_, min(1.0, 2.0*r), min(r,2.0) )
limit=max(_ZERO_, min(ONE, TWO*r), min(r,TWO) )
case (MUSCL)
limit=max(_ZERO_,min(2.0,2.0*r,0.5*(1.0+r)))
limit=max(_ZERO_,min(TWO,TWO*r,0.5*(ONE+r)))
case default
FATAL 'This is not so good - do_advection_3d()'
stop 'w_split_it_adv'
......
......@@ -28,7 +28,7 @@
! suspended matter
#ifndef NO_SUSP_MATTER
REALTYPE, dimension(:,:,:), allocatable :: spm,spm_ws
REALTYPE, dimension(:,:), allocatable :: spm_pool
REALTYPE, dimension(:,:), allocatable :: spm_pool
#endif
#ifdef UV_TVD
......
integer :: iextr=-1, jextr=-1
integer :: imin=-1,imax=-1,jmin=-1,jmax=-1
integer :: iimin=-1,iimax=-1,jjmin=-1,jjmax=-1
integer :: kmax=1
integer :: iextr=-1, jextr=-1
integer :: imin=-1,imax=-1,jmin=-1,jmax=-1
integer :: iimin=-1,iimax=-1,jjmin=-1,jjmax=-1
integer :: kmax=1
integer, dimension(:,:), allocatable :: az,au,av,ax
integer, dimension(:,:), allocatable :: az,au,av,ax
REALTYPE, dimension(:,:), allocatable :: H,HU,HV
REALTYPE, dimension(:,:), allocatable :: lonc,latc,conv
......
!$Id: grid_interpol.F90,v 1.6 2003-10-30 16:31:36 kbk Exp $
!$Id: grid_interpol.F90,v 1.7 2003-12-16 16:50:40 kbk Exp $
#include "cppdefs.h"
#ifndef HALO
#define HALO 0
......@@ -40,7 +40,10 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: grid_interpol.F90,v $
! Revision 1.6 2003-10-30 16:31:36 kbk
! Revision 1.7 2003-12-16 16:50:40 kbk
! added support for Intel/IFORT compiler - expanded TABS, same types in subroutine calls
!
! Revision 1.6 2003/10/30 16:31:36 kbk
! check validity of meteo interpolation coeffcients
!
! Revision 1.5 2003/06/30 05:45:26 kbk
......@@ -575,7 +578,7 @@
gridmap(i,j,1) = im-1
else
outside = .true.
end if
end if
else
endif
......@@ -585,9 +588,9 @@
if(met_lat(jm) .gt. alat) EXIT
end do
gridmap(i,j,2) = jm-1
else
else
outside = .true.
end if
end if
else
endif
end if
......@@ -609,10 +612,10 @@
#endif
if (rotated_grid) then
call to_rotated_lat_lon(sp,olon(i,j),olat(i,j), &
x,y,beta(i,j))
x,y,beta(i,j))
else
x = olon(i,j)
y = olat(i,j)
x = olon(i,j)
y = olat(i,j)
end if
im = gridmap(i,j,1)
jm = gridmap(i,j,2)
......
!$Id: ncdf_3d_bdy.F90,v 1.7 2003-10-07 15:10:42 kbk Exp $
!$Id: ncdf_3d_bdy.F90,v 1.8 2003-12-16 16:50:41 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -43,7 +43,10 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: ncdf_3d_bdy.F90,v $
! Revision 1.7 2003-10-07 15:10:42 kbk
! Revision 1.8 2003-12-16 16:50:41 kbk
! added support for Intel/IFORT compiler - expanded TABS, same types in subroutine calls
!
! Revision 1.7 2003/10/07 15:10:42 kbk
! use zax_dim as argument to dim_len
!
! Revision 1.6 2003/08/03 09:19:41 kbk
......@@ -379,7 +382,10 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: ncdf_3d_bdy.F90,v $
! Revision 1.7 2003-10-07 15:10:42 kbk
! Revision 1.8 2003-12-16 16:50:41 kbk
! added support for Intel/IFORT compiler - expanded TABS, same types in subroutine calls
!
! Revision 1.7 2003/10/07 15:10:42 kbk
! use zax_dim as argument to dim_len
!
! Revision 1.6 2003/08/03 09:19:41 kbk
......@@ -554,13 +560,13 @@ end do
subroutine interpol(zlev,wrk,depth,kmax,zm,col)
REAL_4B :: zlev(18),wrk(18)
REALTYPE :: depth
integer :: kmax
REALTYPE :: zm(0:kmax),col(0:kmax)
REAL_4B :: zlev(18),wrk(18)
REALTYPE :: depth
integer :: kmax
REALTYPE :: zm(0:kmax),col(0:kmax)
REALTYPE :: zmodel(kmax),rat
integer :: k,n,nn
REALTYPE :: zmodel(kmax),rat
integer :: k,n,nn
zmodel(1) = -depth + 0.5*zm(1)
do k=2,kmax
......
!$Id: ncdf_meteo.F90,v 1.8 2003-11-03 14:34:54 kbk Exp $
!$Id: ncdf_meteo.F90,v 1.9 2003-12-16 16:50:41 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -27,55 +27,58 @@
public init_meteo_input_ncdf,get_meteo_data_ncdf
!
! !PRIVATE DATA MEMBERS:
REALTYPE :: offset
integer :: ncid,ndims,dims(3)
integer :: start(3),edges(3)
integer :: u10_id,v10_id,airp_id,t2_id
integer :: hum_id,convp_id,largep_id,tcc_id
integer :: tausx_id,tausy_id,swr_id,shf_id
integer :: iextr,jextr,textr,tmax=-1
integer :: grid_scan=1
REALTYPE, allocatable :: met_lon(:),met_lat(:)
REAL_4B, allocatable :: met_times(:)
REAL_4B, allocatable :: wrk(:,:)
REALTYPE, allocatable :: wrk_dp(:,:)
REALTYPE :: offset
integer :: ncid,ndims,dims(3)
integer :: start(3),edges(3)
integer :: u10_id,v10_id,airp_id,t2_id
integer :: hum_id,convp_id,largep_id,tcc_id
integer :: tausx_id,tausy_id,swr_id,shf_id
integer :: iextr,jextr,textr,tmax=-1
integer :: grid_scan=1
REALTYPE, allocatable :: met_lon(:),met_lat(:)
REAL_4B, allocatable :: met_times(:)
REAL_4B, allocatable :: wrk(:,:)
REALTYPE, allocatable :: wrk_dp(:,:)
! For gridinterpolation
REALTYPE, allocatable :: ti(:,:),ui(:,:)
integer, allocatable :: gridmap(:,:,:)
!
REALTYPE, parameter :: pi=3.1415926535897932384626433832795029
REALTYPE, parameter :: deg2rad=pi/180.,rad2deg=180./pi
REALTYPE :: southpole(3) = (/0.0,-90.0,0.0/)
character(len=10) :: name_lon="lon"
character(len=10) :: name_lat="lat"
character(len=10) :: name_time="time"
character(len=10) :: name_u10="u10"
character(len=10) :: name_v10="v10"
character(len=10) :: name_airp="slp"
character(len=10) :: name_t2="t2"
character(len=10) :: name_hum1="sh"
character(len=10) :: name_hum2="rh"
character(len=10) :: name_hum3="dev2"
character(len=10) :: name_hum4="twet"
character(len=10) :: name_tcc="tcc"
integer, parameter :: SPECIFIC_HUM=1
integer, parameter :: RELATIVE_HUM=2
integer, parameter :: DEW_POINT=3
integer, parameter :: WET_BULB=4
character(len=10) :: name_tausx="tausx"
character(len=10) :: name_tausy="tausy"
character(len=10) :: name_swr="swr"
character(len=10) :: name_shf="shf"
character(len=128) :: model_time
REALTYPE, allocatable :: ti(:,:),ui(:,:)
integer, allocatable :: gridmap(:,:,:)
!
REALTYPE, parameter :: pi=3.1415926535897932384626433832795029
REALTYPE, parameter :: deg2rad=pi/180.,rad2deg=180./pi
REALTYPE :: southpole(3) = (/0.0,-90.0,0.0/)
character(len=10) :: name_lon="lon"
character(len=10) :: name_lat="lat"
character(len=10) :: name_time="time"
character(len=10) :: name_u10="u10"
character(len=10) :: name_v10="v10"
character(len=10) :: name_airp="slp"
character(len=10) :: name_t2="t2"
character(len=10) :: name_hum1="sh"
character(len=10) :: name_hum2="rh"
character(len=10) :: name_hum3="dev2"
character(len=10) :: name_hum4="twet"
character(len=10) :: name_tcc="tcc"
integer, parameter :: SPECIFIC_HUM=1
integer, parameter :: RELATIVE_HUM=2
integer, parameter :: DEW_POINT=3
integer, parameter :: WET_BULB=4
character(len=10) :: name_tausx="tausx"
character(len=10) :: name_tausy="tausy"
character(len=10) :: name_swr="swr"
character(len=10) :: name_shf="shf"
character(len=128) :: model_time
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: ncdf_meteo.F90,v $
! Revision 1.8 2003-11-03 14:34:54 kbk
! Revision 1.9 2003-12-16 16:50:41 kbk
! added support for Intel/IFORT compiler - expanded TABS, same types in subroutine calls
!
! Revision 1.8 2003/11/03 14:34:54 kbk
! use time_var_id in addition to time_id
!
! Revision 1.7 2003/10/30 16:31:36 kbk
......@@ -141,8 +144,8 @@
! \emph{get\_meteo\_data\_ncdf}.
!
! !INPUT PARAMETERS:
character(len=*), intent(in) :: fn
integer, intent(in) :: nstart
character(len=*), intent(in) :: fn
integer, intent(in) :: nstart
!
! !INPUT/OUTPUT PARAMETERS:
!
......@@ -153,9 +156,9 @@
! See module for log.
!
! !LOCAL VARIABLES:
integer :: i,j,n
integer :: err
logical :: ok=.true.
integer :: i,j,n
integer :: err
logical :: ok=.true.
!EOP
!-------------------------------------------------------------------------
include "netcdf.inc"
......@@ -195,10 +198,10 @@
met_lon(i) = -10.125 + (i-1)*1.125
end do
do j=1,jextr
met_lat(j) = 28.125 + (j-1)*1.125
met_lat(j) = 28.125 + (j-1)*1.125
end do
#endif
call init_grid_interpol(imin,imax,jmin,jmax,az, &
call init_grid_interpol(imin,imax,jmin,jmax,az, &
lonc,latc,met_lon,met_lat,southpole,gridmap,ti,ui)
end if
......@@ -307,7 +310,7 @@
! necessary.
!
! !INPUT PARAMETERS:
integer, intent(in) :: loop
integer, intent(in) :: loop
!
! !INPUT/OUTPUT PARAMETERS:
!
......@@ -318,15 +321,15 @@
! See module for log.
!
! !LOCAL VARIABLES:
integer :: i,indx
REALTYPE :: t
logical, save :: first=.true.
integer, save :: save_n=1
integer :: i,indx
REALTYPE :: t
logical, save :: first=.true.
integer, save :: save_n=1
!
!EOP
!-------------------------------------------------------------------------
#ifdef DEBUG
integer, save :: Ncall = 0
integer, save :: Ncall = 0
Ncall = Ncall+1
write(debug,*) 'get_meteo_data_ncdf() # ',Ncall
#endif
......@@ -402,7 +405,7 @@
! and that they are of the same shape.
!
! !INPUT PARAMETERS:
character(len=*), intent(in) :: meteo_file
character(len=*), intent(in) :: meteo_file
!
! !INPUT/OUTPUT PARAMETERS:
!
......@@ -413,15 +416,15 @@
! See module for log.
!
! !LOCAL VARIABLES:
integer, parameter :: iunit=55
character(len=256) :: fn,time_units
integer :: j1,s1,j2,s2
integer :: n,err,idum
logical :: first=.true.
logical :: found=.false.,first_open=.true.
integer, save :: lon_id=-1,lat_id=-1,time_id=-1,id=-1
integer, save :: time_var_id=-1
character(len=256) :: dimname
integer, parameter :: iunit=55
character(len=256) :: fn,time_units
integer :: j1,s1,j2,s2
integer :: n,err,idum
logical :: first=.true.
logical :: found=.false.,first_open=.true.
integer, save :: lon_id=-1,lat_id=-1,time_id=-1,id=-1
integer, save :: time_var_id=-1
character(len=256) :: dimname
!
! !TO DO:
! Need a variable to indicate homw much to read from each file.
......@@ -429,7 +432,7 @@
!-------------------------------------------------------------------------
include "netcdf.inc"
#ifdef DEBUG
integer, save :: Ncall = 0
integer, save :: Ncall = 0
Ncall = Ncall+1
write(debug,*) 'open_meteo_file() # ',Ncall
#endif
......@@ -474,15 +477,15 @@
tmax=textr
end if
end do
if(lon_id .eq. -1) then
if(lon_id .eq. -1) then
FATAL 'could not find longitude coordinate in meteo file'
stop 'open_meteo_file()'
end if
if(lat_id .eq. -1) then
if(lat_id .eq. -1) then
FATAL 'could not find latitude coordinate in meteo file'
stop 'open_meteo_file()'
end if
if(time_id .eq. -1) then