*=*=*=*= inifilr_old.html =*=*=*=*
SUBROUTINE inifilr_old 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) real rlamda( iim ), eignvl( iim ) c REAL lamdamax,pi,cof,colat0 integer imm1,im2,i,j,modemax,imx,k,kf 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" imm1 = iim - 1 im2 = 2. * iim pi = 2. * ASIN( 1. ) do i=1,iim dlonu(i)=fxprim(float(i)+0.5) ENDDO CALL inifgn(eignvl) 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 dy/ min.de dx a l'equateur ... c colat0 = 0.5 PRINT 50, colat0 50 FORMAT(/15x'WARNING!!!! colat0 impose: 'e16.7) c lamdamax = iim / (pi * colat0) 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 modemax = iim c imx = modemax - 4 * (modemax/iim) imx = modemax PRINT *,' TRUNCATION AT ',imx c DO 75 j = 2, jjm/2+1 c cof = rlamda(imx) * COS( rlatu(j) ) c print *,' ....j cofu ..',cof,j,rlatu(j) IF ( cof .LT. 1 ) THEN jfiltnu= j ENDIF c cof = rlamda(imx) * COS( rlatv(j) ) c print *,' ....j cofv ..',cof,j,rlatv(j) IF ( cof .LT. 1 ) THEN jfiltnv = j ENDIF c cof = rlamda(imx) * COS( rlatu(jjp1-j+1) ) IF ( cof .LT. 1 ) THEN jfiltsu = jjp1-j+1 ENDIF c cof = rlamda(imx) * COS( rlatv(jjp1-j+1) ) IF ( cof .LT. 1 ) THEN jfiltsv = jjp1-j+1 ENDIF c 75 CONTINUE c DO 77 j = 1,jjm modfrstu( j ) = iim modfrstv( j ) = iim 77 CONTINUE c............................................................. c DO 80 j = 2,jfiltnu DO 81 k = 2,modemax cof = rlamda(k) * COS( rlatu(j) ) IF ( cof .LT. 1 ) GOTO 82 81 CONTINUE GOTO 80 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 80 CONTINUE c DO 85 j = 1,jfiltnv DO 86 k = 2,modemax cof = rlamda(k) * COS( rlatv(j) ) IF ( cof .LT. 1 ) GOTO 87 86 CONTINUE GOTO 85 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 85 CONTINUE c DO 90 j = jfiltsu,jjm DO 91 k = 2,modemax cof = rlamda(k) * COS( rlatu(j) ) IF ( cof .LT. 1 ) GOTO 92 91 CONTINUE GOTO 90 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 90 CONTINUE c DO 95 j = jfiltsv,jjm DO 96 k = 2,modemax cof = rlamda(k) * COS( rlatv(j) ) IF ( cof .LT. 1 ) GOTO 97 96 CONTINUE GOTO 95 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 95 CONTINUE 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 ENDc