*=*=*=*= inifilr.html =*=*=*=*
SUBROUTINE inifilr c c ... H. Upadhyaya, O.Sharma ... c IMPLICIT NONE c c version 2 ..... c ------------------------------------------------------------------- #include "dimensions.h" #include "paramet.h" c ------------------------------------------------------------------- #include "comgeom.h" #include "coefils.h" #include "serre.h" REAL dlonu(iim),dlatu(jjm) REAL rlamda( iim ), eignvl( iim ) c REAL lamdamax,pi,cof INTEGER i,j,modemax,imx,k,kf INTEGER iymin,ixmineq,ISMIN REAL dymin,dxmin,colat0,pi_flt,AMIN1 EXTERNAL ISMIN EXTERNAL inifgn c c ------------------------------------------------------------ c This routine computes the eigenfunctions of the laplacien c on the stretched grid, and the filtering coefficients c c We designate: c eignfn eigenfunctions of the discrete laplacien c eigenvl eigenvalues c jfiltn indexof the last scalar line filtered in NH c jfilts index of the first line filtered in SH c modfrst index of the mode from where modes are filtered c modemax maximum number of modes ( im ) c coefil filtering coefficients ( lamda_max*cos(rlat)/lamda ) c sdd SQRT( dx ) c c the modes are filtered from modfrst to modemax c c----------------------------------------------------------- c #include "fxyprim.h" pi = 2. * ASIN( 1. ) DO i=1,iim dlonu(i)=fxprim( FLOAT(i)+0.5 ) ENDDO c CALL inifgn(eignvl) c PRINT *,'eigenvl ....',eignvl c c compute eigenvalues and eigenfunctions c c c................................................................. c c compute the filtering coefficients for scalar lines and c meridional wind v-lines c c we filter all those latitude lines where coefil < 1 c NO FILTERING AT POLES c c colat0 is to be used when alpha (stretching coefficient) c is set equal to zero for the regular grid case c c ....... Calcul de colat0 ......... c ..... colat0 = minimum de ( 0.5, min dy/ min dx ) ... c c DO 45 j = 1,jjm dlatu( j ) = rlatu( j ) - rlatu( j+1 ) 45 CONTINUE c iymin = ISMIN( jjm, dlatu, 1 ) ixmineq = ISMIN( iim, dlonu, 1 ) dymin = dlatu( iymin ) dxmin = dlonu( ixmineq ) c c ... P.Le Van , 8/11/94 .. c colat0 = AMIN1( 0.5, dymin/dxmin ) c PRINT 50, colat0 50 FORMAT(/15x'colat0'e16.7) c IF( alphax.EQ. 0.) THEN lamdamax = iim / (pi * colat0) ELSE lamdamax = iim / (pi * alphax) ENDIF c DO 71 i = 2,iim rlamda( i ) = lamdamax/ SQRT( ABS( eignvl(i) ) ) 71 CONTINUE c DO 72 j = 1,jjm DO 73 i = 1,iim coefilu( i,j ) = 0.0 coefilv( i,j ) = 0.0 coefilu2( i,j ) = 0.0 coefilv2( i,j ) = 0.0 73 CONTINUE 72 CONTINUE c c ... Determination de jfiltnu,jfiltnv,jfiltsu,jfiltsv .... c ......................................................... c modemax = iim imx = modemax - 4 * (modemax/iim) PRINT *,' TRUNCATION AT ',imx c DO 75 j = 2, jjm/2+1 cof = COS( rlatu(j) )/ colat0 IF ( cof .LT. 1. ) THEN IF( rlamda(imx) * COS(rlatu(j) ).LT.1. ) jfiltnu= j ENDIF cof = COS( rlatu(jjp1-j+1) )/ colat0 IF ( cof .LT. 1. ) THEN IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ).LT.1. ) $ jfiltsu= jjp1-j+1 ENDIF 75 CONTINUE c DO 76 j = 1, jjm/2 cof = COS( rlatv(j) )/ colat0 IF ( cof .LT. 1. ) THEN IF( rlamda(imx) * COS(rlatv(j) ).LT.1. ) jfiltnv= j ENDIF cof = COS( rlatv(jjm-j+1) )/ colat0 IF ( cof .LT. 1. ) THEN IF( rlamda(imx) * COS(rlatv(jjm-j+1) ).LT.1. ) $ jfiltsv= jjm-j+1 ENDIF 76 CONTINUE c c c ... Determination de coefilu,coefilv,n=modfrstu,modfrstv .... c................................................................ c c DO 77 j = 1,jjm modfrstu( j ) = iim modfrstv( j ) = iim 77 CONTINUE c DO 84 j = 2,jfiltnu DO 81 k = 2,modemax cof = rlamda(k) * COS( rlatu(j) ) IF ( cof .LT. 1. ) GOTO 82 81 CONTINUE GOTO 84 82 modfrstu( j ) = k c kf = modfrstu( j ) DO 83 k = kf , modemax cof = rlamda(k) * COS( rlatu(j) ) coefilu(k,j) = cof - 1. coefilu2(k,j) = cof*cof - 1. 83 CONTINUE 84 CONTINUE c c DO 89 j = 1,jfiltnv c DO 86 k = 2,modemax cof = rlamda(k) * COS( rlatv(j) ) IF ( cof .LT. 1. ) GOTO 87 86 CONTINUE GOTO 89 87 modfrstv( j ) = k c kf = modfrstv( j ) DO 88 k = kf , modemax cof = rlamda(k) * COS( rlatv(j) ) coefilv(k,j) = cof - 1. coefilv2(k,j) = cof*cof - 1. 88 CONTINUE c 89 CONTINUE c DO 94 j = jfiltsu,jjm DO 91 k = 2,modemax cof = rlamda(k) * COS( rlatu(j) ) IF ( cof .LT. 1. ) GOTO 92 91 CONTINUE GOTO 94 92 modfrstu( j ) = k c kf = modfrstu( j ) DO 93 k = kf , modemax cof = rlamda(k) * COS( rlatu(j) ) coefilu(k,j) = cof - 1. coefilu2(k,j) = cof*cof - 1. 93 CONTINUE 94 CONTINUE c DO 99 j = jfiltsv,jjm DO 96 k = 2,modemax cof = rlamda(k) * COS( rlatv(j) ) IF ( cof .LT. 1. ) GOTO 97 96 CONTINUE GOTO 99 97 modfrstv( j ) = k c kf = modfrstv( j ) DO 98 k = kf , modemax cof = rlamda(k) * COS( rlatv(j) ) coefilv(k,j) = cof - 1. coefilv2(k,j) = cof*cof - 1. 98 CONTINUE 99 CONTINUE c PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' , * jfiltnv,jfiltsv,jfiltnu,jfiltsu IF(jfiltnv.GE.jjm/2 .OR. jfiltnu.GE.jjm/2)THEN IF(jfiltnv.EQ.jfiltsv)jfiltsv=1+jfiltnv IF(jfiltnu.EQ.jfiltsu)jfiltsu=1+jfiltnu PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' , * jfiltnv,jfiltsv,jfiltnu,jfiltsu ENDIF PRINT *,' Modes premiers v ' PRINT 334,modfrstv PRINT *,' Modes premiers u ' PRINT 334,modfrstu 334 FORMAT(1x,24i3) c RETURN END