PGF90 (Version     12.8)          08/30/2020  00:27:48      page 1

Switches: -noasm -nodclchk -debug -nodlines -line -list
          -idir ../include
          -inform warn -opt 0 -nosave -object -noonetrip
          -depchk on -nostandard     
          -symbol -noupcase    

Filename: cube2llH.f90

(    1) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
(    2)        subroutine cube2llh( h, hg, lmax) 
(    3) !      *****************************************************************
(    4) !      *                                                               *
(    5) !      *   Set scalar array for graphical output on cubic grid         *
(    6) !      *                                                               *
(    7) !      *****************************************************************
(    8) !----------------------------------------------------------------------
(    9)        USE mod_graph
(   10)       include 'param_o.h'
(   11) !----------------------------------------------------------------------
../include/param_o.h
(    1)*      integer,parameter  :: im0=401
(    2)*      integer, parameter :: nm=6
(    3)*      integer, parameter :: lm = 50
(    4)*      integer, parameter :: nsub = 10
(    5)*
(    6)*      integer, parameter :: im=im0, jm=im
(    7)*      integer, parameter :: im1=im-1, jm1=jm-1
(    8)*
(    9)*      integer, parameter :: lm1 = lm-1, lp1 =lm +1  
(   10)*
(   11)*      integer, parameter :: ixm = nsub, jym = ixm, nxy = ixm*jym
(   12)*      integer, parameter :: ildom = (im - 1)/ixm, jldom = (jm - 1)/jym
(   13)*      integer, parameter :: ilm = (im - 1)/ixm +1, jlm = (jm - 1)/jym +1 
(   14)*
(   15)*      logical,parameter::flat=.false.
(   16)*      logical,parameter::hstst=.false.
(   17)*
(   18)*!      integer,parameter::igm=360, jgm = 181
(   19)*      integer,parameter::igm=(im0-1)*4, jgm = (igm/2)+1      
(   20)*      real,parameter::alfa=0.0, beta=0.0, gamm=0.0
(   21)*!      real,parameter::alfa=0.*3.1415926/180.,beta=66.*3.1415926/180. &
(   22)*!	              ,gamm=175.*3.1415926/180.
(   23)*
(   24)*!GSM      integer,parameter::lsm=20
(   25)*      integer,parameter::lsm=31
(   26)*
(   27)*!RESTART
(   28)*
(   29)*      character(len=10):: restartdate='2020080412'    !restart date to create appropriate folder name
(   12)        real,parameter::one=1.  
(   13) !-----------------------------------------------------------------------
(   14)        dimension  &
(   15)        h   (0:im+1,0:jm+1,nm,lmax)  &
(   16)       ,hg  (igm,jgm,lmax)
(   17)         integer::i,j,l,il,jl
(   18) 	real::x1a(4),x2a(4),ya(4,4),dy
(   19) 
(   20) 	x1a=(/-1.,0.,1.,2./)
(   21) 	x2a=(/-1.,0.,1.,2./)






PGF90 (Version     12.8)          08/30/2020  00:27:48      page 2

(   22) !-----------------------------------------------------------------------
(   23)       do j=1,jgm
(   24)       do i=1,igm
(   25)         xmap=XMP0(i,j)
(   26)         ymap=YMP0(i,j)
(   27)         kmap=KMP0(i,j)
(   28)         
(   29)         xsi=xmap*(im-1)
(   30)         eta=ymap*(jm-1)
(   31)           il=xsi+1
(   32)           jl=eta+1
(   33)         xsi=xsi-il+1
(   34)         eta=eta-jl+1
(   35)         omxsi=one-xsi
(   36)         ometa=one-eta
(   37) !	if(il.eq.1.or.il.eq.im-1.or.jl.eq.1.or.jl.eq.jm-1)then
(   38)       HG(i,j,1:lmax)=H(il,jl,kmap,:)*omxsi*ometa+H(il+1,jl,kmap,:)*xsi*ometa  &
(   39)                +H(il,jl+1,kmap,:)*omxsi*eta+H(il+1,jl+1,kmap,:)*xsi*eta
(   40) !        else
(   41) !	  do l=1,lmax
(   42) !	   ya=H(il-1:il+2,jl-1:jl+2,kmap,l)
(   43) !	   call polin2(x1a,x2a,ya,4,4,xsi,eta,hg(i,j,l),dy)
(   44) !          enddo
(   45) !        endif
(   46) !        print *,i,j,kmap,il,jl,glon(i,j)*180/3.14,glat(i,j)*180/3.14
(   47)       if(i.eq.61.and.j.eq.91)then
(   48) !        print *,i,j,il,jl,kmap
(   49) !	stop
(   50)       endif
(   51)       end do
(   52)       end do
(   53) !-----------------------------------------------------------------------
(   54)                                Return
(   55)                                End