source: trunk/LMDZ.GENERIC/deftank/def_generic_giants/randomRestart/createRandomStart.f90 @ 2613

program createRandomStart

USE netcdf

implicit none

!=======================================================================
! Copy a start.nc file and change ucov, vcov, teta variables:
!       teta -> teta +/- dTeta (K)
!       ucov -> (0 +/- duNat)*cu (m/s)
!       vcov -> (0 +/- dvNat)*cv (m/s)
! Perturbations are vertically the same.
!=======================================================================

!Input
 character (len=100) :: fileNetcdfInput ! input start.nc netcdf file
!Output
 character (len=100) :: fileNetcdf ! output start.nc netcdf file
!Usefull stuff
integer :: nLat,nRlatv,nLong,nRlonu,nAlt,nTime ! dimensions  in netcdf file (redundant point in longitude)
real, dimension (:,:,:,:), allocatable :: uCov,vCov,uNat,vNat,uNat2,vNat2,teta
real, dimension (:,:), allocatable :: cu,cv
real :: duNat,dvNat,dTeta
!Netcdf declarations
integer :: idFile,idStuff,idUcov,idVcov,idCu,idCv,idTeta
integer :: ierror
!Temporary variables
 character (len=100) :: format,varTmp
integer :: i,j,k,l,N=1,dimFilter
logical :: isFile
real :: alea
 character (len=200) :: command


print*,'input start.nc?'
read*, fileNetcdfInput
inquire(file=fileNetcdfInput,exist=isFile)
if (isFile .eqv. .false.) then
        stop 'input doesn t exist'
end if

print*,'output start.nc?'
read*, fileNetcdf
inquire(file=fileNetcdf,exist=isFile)
if (fileNetcdfInput == fileNetcdf) then
        !name of the input netcdf file back-up
        varTmp=trim(fileNetcdfInput) // '.old'
        inquire(file=varTmp,exist=isFile)
        do while(isFile .eqv. .true.)
                varTmp=trim(varTmp) // '.old'
                print*,varTmp
                inquire(file=varTmp,exist=isFile)
        end do
        !input netcdf file back-up
        write(command,'(a6,a50,a1,a50)') 'cp -f ',trim(fileNetcdfInput),' ',trim(varTmp)
        call system(command)
else
        inquire(file=fileNetcdf,exist=isFile)
        if (isFile .eqv. .true.) then
                print*,'output name existing. Want to overwrite? (y/n)'
                read*,varTmp
                if (varTmp == 'y') then
                        write(command,'(a6,a50)') 'rm -f ',fileNetcdf
                        print*,command
                        call system(command)
                else
                        stop 'existing output not deleted'
                end if
        end if
end if

print*,'du (m/s)?'
read*, duNat

print*,'dv (m/s)?'
read*, dvNat

print*,'dT (K)?'
read*, dTeta

!print*,'dim average filter? (0 --> no | 1,2,3... --> average)'
!read*, dimFilter
dimFilter=0

!Creation of the output netcdf file if different from input netcdf file
if (fileNetcdfInput /= fileNetcdf) then
        write(command,'(a6,a50,a1,a50)') 'cp -f ',fileNetcdfInput,' ',fileNetcdf
        print*,command
        call system(command)
end if

!**********
!Netcdf file reading
PRINT*,'**********'
PRINT*,'Netcdf file reading'
!Open
ierror=nf90_open(fileNetcdf,NF90_WRITE,idFile)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped open"
end if
!Read dimension latitude
ierror=nf90_inq_dimid(idFile,'latitude',idStuff)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped"
end if
ierror=nf90_inquire_dimension(idFile,idStuff,varTmp,nLat)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped dim lat"
end if
!Read dimension latitude bis
ierror=nf90_inq_dimid(idFile,'rlatv',idStuff)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped"
end if
ierror=nf90_inquire_dimension(idFile,idStuff,varTmp,nRlatv)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped dim rlatv"
end if
!Read dimension longitude
ierror=nf90_inq_dimid(idFile,'longitude',idStuff)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped"
end if
ierror=nf90_inquire_dimension(idFile,idStuff,varTmp,nLong)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped dim long"
end if
!Read dimension longitude bis
ierror=nf90_inq_dimid(idFile,'rlonu',idStuff)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped"
end if
ierror=nf90_inquire_dimension(idFile,idStuff,varTmp,nRlonu)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped dim rlonu"
end if
!Read dimension altitude
ierror=nf90_inq_dimid(idFile,'altitude',idStuff)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped"
end if
ierror=nf90_inquire_dimension(idFile,idStuff,varTmp,nAlt)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped dim alt"
end if
!Read dimension time
ierror=nf90_inq_dimid(idFile,'Time',idStuff)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped"
end if
ierror=nf90_inquire_dimension(idFile,idStuff,varTmp,nTime)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped dim time"
end if
!Read variables ucov and vcov
allocate(uCov(nRlonu,nLat,nAlt,nTime))
allocate(vCov(nLong,nRlatv,nAlt,nTime))
ierror=nf90_inq_varid(idFile,"ucov",idUcov)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped"
end if
ierror=nf90_get_var(idFile,idUcov,uCov)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped get_var ucov"
end if
ierror=nf90_inq_varid(idFile,"vcov",idVcov)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped"
end if
ierror=nf90_get_var(idFile,idVcov,vCov)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped get_var vcov"
end if
!Read variables cu and cv
allocate(cu(nRlonu,nLat))
allocate(cv(nLong,nRlatv))
ierror=nf90_inq_varid(idFile,"cu",idCu)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped"
end if
ierror=nf90_get_var(idFile,idCu,cu)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped get_var cu"
end if
ierror=nf90_inq_varid(idFile,"cv",idCv)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped"
end if
ierror=nf90_get_var(idFile,idCv,cv)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped get_var cv"
end if
!Read variables teta
allocate(teta(nLong,nLat,nAlt,nTime))
ierror=nf90_inq_varid(idFile,"teta",idTeta)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped"
end if
ierror=nf90_get_var(idFile,idTeta,teta)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped get_var teta"
end if

!**********
!uNat
allocate(uNat(nRlonu,nLat,nAlt,nTime))
uNat(:,:,:,:)=0.0
do i=1,nLong
do j=1,nLat
do k=1,nAlt
do l=1,nTime
        call random_number(alea)
        uNat(i,j,k,l) = -duNat+2*duNat*alea
end do
end do
end do
end do
!-/+180 longitude points must be the same
uNat(1,:,:,:)=uNat(nLong,:,:,:)
!**********
!vNat
allocate(vNat(nLong,nRlatv,nAlt,nTime))
vNat(:,:,:,:)=0.0
do i=1,nLong
do j=1,nRlatv
do k=1,nAlt
do l=1,nTime
        call random_number(alea)
        vNat(i,j,k,l) = -dvNat+2*dvNat*alea
end do
end do
end do
end do
!-/+180 longitude points must be the same
vNat(1,:,:,:)=vNat(nLong,:,:,:)
!**********
!mean (if dimFilter=0 mean mean_filter has no effect)
allocate(uNat2(nRlonu,nLat,nAlt,nTime))
allocate(vNat2(nLong,nRlatv,nAlt,nTime))
uNat2(:,:,:,:)=uNat(:,:,:,:)
vNat2(:,:,:,:)=vNat(:,:,:,:)
do k=1,nAlt
do l=1,nTime
        call mean_filter(uNat(:,:,k,l),nRlonu,nLat,dimFilter,uNat2(:,:,k,l))
        call mean_filter(vNat(:,:,k,l),nLong,nRlatv,dimFilter,vNat2(:,:,k,l))
end do
end do
!**********
!new ucov and vcov
do k=1,nAlt
do l=1,nTime
        uCov(:,:,k,l)=uNat2(:,:,k,l)*cu
        vCov(:,:,k,l)=vNat2(:,:,k,l)*cv
end do
end do
!**********
!teta
do i=1,nLong
do j=1,nRlatv
do k=1,nAlt
do l=1,nTime
        call random_number(alea)
        teta(i,j,k,l) = teta(i,j,k,l)-dTeta+2*dTeta*alea
end do
end do
end do
end do
teta(1,:,:,:)=teta(nLong,:,:,:)
!**********
!Write variable ucov and vcov
ierror=nf90_put_var(idFile,idUcov,uCov) !,(1,1,1,1),(nLong,nLat,nAlt,nTime),
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped put ucov"
end if
ierror=nf90_put_var(idFile,idVcov,vCov) !,(1,1,1,1),(nLong,nLat,nAlt,nTime),
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped put vcov"
end if
!**********
!Write variable teta
ierror=nf90_put_var(idFile,idTeta,teta) !,(1,1,1,1),(nLong,nLat,nAlt,nTime),
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped put teta"
end if
!**********
!Close
ierror=nf90_close(idFile)
if(ierror /= nf90_noerr) then 
     print *, trim(nf90_strerror(ierror))
     stop "Stopped close"
end if

contains

subroutine interface_user(fileNetcdf,duNat,dvNat,dTeta)

implicit none

 character (len=*), intent(out) :: fileNetcdf
real, intent(out) :: duNat,dvNat,dTeta






end subroutine interface_user

subroutine mean_filter(matrix,m,n,dimFilter,matrixOut)

implicit none

integer, intent(in) :: m,n,dimFilter
real, dimension(m,n), intent(in) :: matrix
real, dimension(m,n), intent(out) :: matrixOut
real, dimension(m+2*dimFilter,n+2*dimFilter) :: matrixTmp,matrixConv
real, dimension(2*dimFilter+1,2*dimFilter+1) :: kernel
integer :: mm,nn

!matrix containing input matrix plus zero edges
matrixTmp(:,:)=0.0
mm=m+2*dimFilter
nn=n+2*dimFilter
do i=dimFilter+1,mm-dimFilter
        do j=dimFilter+1,nn-dimFilter
                matrixTmp(i,j)=matrix(i-dimFilter,j-dimFilter)
        end do
end do
!print*,matrixTmp(5,:)

!filter creation
kernel(:,:) = 1.0/((2*dimFilter+1)*(2*dimFilter+1))
!print*,kernel

!matrix convolution with the filter
do i=dimFilter+1,mm-dimFilter
        do j=dimFilter+1,nn-dimFilter
                matrixConv(i,j)=sum(matrixTmp(i-dimFilter:i+dimFilter,j-dimFilter:j+dimFilter)*kernel)
        end do
end do
i=5
j=5
!print*,shape(matrixTmp(i-dimFilter:i+dimFilter,j-dimFilter:j+dimFilter))
!print*,matrixConv(5,:)

!extraction of submatrix without zeros edges
matrixOut(:,:)=0.0
do i=1,m
        do j=1,n
                matrixOut(i,j)=matrixConv(i+dimFilter,j+dimFilter)
        end do
end do

end subroutine mean_filter

end program createRandomStart