SUBROUTINE GNMINI(DK,TK,SATCRI,DISPK,PERCUT,MODS,NITER,NF) COMMON IDATE(4), * GESHEM( 50 , 42 ),TSEA( 50 , 42 ),GRGRID( 50 , 42 ) COMMON DPDPHI( 306 ),DPDLAM( 289 ),RELVOR( 7 ),ABSVOR( 7 ), 1 Q( 289 ), TE( 289 , 7 ), DI( 289 , 7 ), ZE( 289 , 7 ), 2 Z( 289 ), Y( 289 , 7 ), X( 289 , 7 ), W( 289 , 7 ), 3 QM( 289 ),TEM( 289 , 7 ),DIM( 289 , 7 ),ZEM( 289 , 7 ), 5 GZ( 289 ), RQ( 289 , 6 ), RM( 289 , 6 ), RT( 289 , 6 ) COMPLEX GZ,Q,TE,DI,ZE,Z,Y,X,W,QM,TEM,DIM,ZEM,RELVOR, 1DPDLAM,DPDPHI,ABSVOR,RQ,RM,RT COMMON * PS( 50 ), DPHI( 50 ), DLAM( 50 ), * QF( 50 ),DPHIF( 50 ),DLAMF( 50 ), * EF( 50 , 7 ), EEF( 50 , 7 ), CG( 50 , 7 ), * TF( 50 , 7 ), TEF( 50 , 7 ),TAU( 50 , 7 ), * AF( 50 , 7 ), ZEF( 50 , 7 ), A( 50 , 7 ), * BF( 50 , 7 ), DIF( 50 , 7 ), B( 50 , 7 ), * FF( 50 , 7 ), UF( 50 , 7 ), F( 50 , 7 ), * GF( 50 , 7 ), VF( 50 , 7 ), G( 50 , 7 ), * UQF( 50 , 6 ), UQFF( 50 , 6 ), * VQF( 50 , 6 ), VQFF( 50 , 6 ), * RQF( 50 , 6 ), RQFF( 50 , 6 ), RTG( 50 , 6 ) COMMON * U1( 50 ),V1( 50 ),T1( 50 ),Q1( 50 ), * U2( 50 ),V2( 50 ),T2( 50 ),Q2( 50 ) COMMON/PLNCOM/PLN( 306 ),DER( 289 ),PLNWCS( 289 ),EPS( 306 ), 1 COLRAD( 21 ),WGT( 21 ),WGTCS( 21 ),RCS2( 21 ) DOUBLE PRECISION COLRAD,EPS COMMON/VERCOM/AM( 7 , 7 ),HM( 7 , 7 ),TM( 7 , 7 ), O BM( 7 , 7 ),CM( 7 , 7 ),EKIN( 7 ), 1 SI( 8 ),SL( 7 ),DEL( 7 ),RDEL2( 7 ),RMSDOT( 6 ), 2 CI( 8 ),CL( 7 ),TOV( 7 ), SV( 7 ), RPI( 6 ), 3 P1( 7 ),P2( 7 ), H1( 7 ), H2( 7 ),RPIREC( 6 ), 4 ROTSIN,ROTCOS,SEADRY,SL1KAP,C1,C2,RLRV,SL100K C ----------------------MEMBER GCOM--------------------------------- DIMENSION EIGG( 7 , 7 ),EIGGT( 7 , 7 ), 1DOTPRO( 7 ),GH( 7 ),VERIN( 7 ),TO( 7 ) COMMON/NMODF/NFILES C**** IF NFILES.EQ.1 , ONE LARGE DATASET FOR NORMAL MODES DATA DT/1./,TPS/0./ WRITE(6,100) 100 FORMAT(1H0,'INPUT VALUES') CALL RMS(QM,DIM,ZEM,TEM) REWIND NF DO 2000 ITER=1,NITER READ(NF)EIGG,EIGGT,GH,DOTPRO,TO DO 10 K=1, 7 VERIN(K)=0. DO 10 J=1, 7 10 VERIN(K)=VERIN(K)+SV(J)*EIGG(J,K) IF(NFILES.NE.1)REWIND NF CALL BMCM(TOV,P1,P2,H1,H2,DEL,CI,BM,CM,DT,SV,AM) CALL GLOOP(TPS) CALL TEND(Z,X,Y,QM,DIM,TEM,AM,TOV,BM,DEL) WRITE(6,101)ITER 101 FORMAT(1H0,'TENDENCIES AT ITERATION ',I2) CALL RMS(Z,X,W,Y) C*** CREATE COMPOSITE VARIABLE=(PHI+R*TO*Q)(DOT) DO 20 LEV=1, 7 DO 20 I=1, 289 ZE(I,LEV)=CMPLX( 287.05 * TO(LEV)* REAL(Z(I)), 1 287.05 * TO(LEV)*AIMAG(Z(I))) DO 15 K=1, 7 ZE(I,LEV)=ZE(I,LEV)+CMPLX(HM(LEV,K)* REAL(Y(I,K)), 1 HM(LEV,K)*AIMAG(Y(I,K))) 15 CONTINUE 20 CONTINUE CALL VERTIC(X ,EIGG,EIGGT,DOTPRO,MODS,-1) CALL VERTIC(W ,EIGG,EIGGT,DOTPRO,MODS,-1) CALL VERTIC(ZE,EIGG,EIGGT,DOTPRO,MODS,-1) CALL PRIMES(W,X,ZE,GH,MODS,-1) C******** CALL HORIZ1(W,X,ZE,EEF,ZEF,PS,RT,RTG,DK,TK,PERCUT,NF,MODS) C******** CALL PRIMES(W,X,ZE,GH,MODS,+1) C*** COMPUTE DELTA(Q) FROM COMPOSITE VARIABLE DO 30 I=1, 289 Z(I)=(0.,0.) DO 30 MOD=1,MODS Z(I)=Z(I)+CMPLX( 1 -VERIN(MOD)* REAL(ZE(I,MOD))/GH(MOD), 2 -VERIN(MOD)*AIMAG(ZE(I,MOD))/GH(MOD)) 30 CONTINUE CALL VERTIC(X ,EIGG,EIGGT,DOTPRO,MODS,+1) CALL VERTIC(W ,EIGG,EIGGT,DOTPRO,MODS,+1) CALL VERTIC(ZE,EIGG,EIGGT,DOTPRO,MODS,+1) C*** COMPUTE DELTA(PHI) FROM COMPOSITE VARIABLE DO 40 LEV=1, 7 DO 40 I=1, 289 ZE(I,LEV)=ZE(I,LEV)-CMPLX( 287.05 *TO(LEV)* REAL(Z(I)), 1 287.05 *TO(LEV)*AIMAG(Z(I))) 40 CONTINUE C*** COMPUTE DELTA(T) FROM PHI DO 50 LEV=1, 7 DO 50 I=1, 289 Y(I,LEV)=(0.,0.) DO 45 K=1, 7 Y(I,LEV)=Y(I,LEV)+CMPLX(TM(LEV,K)* REAL(ZE(I,K)), 1 TM(LEV,K)*AIMAG(ZE(I,K))) 45 CONTINUE 50 CONTINUE DO 60 I=1, 289 Q(I)=QM(I)-Z(I) QM(I)=Q(I) 60 CONTINUE DO 70 K=1, 7 DO 70 I=1, 289 TE(I,K)=TEM(I,K)-Y(I,K) TEM(I,K)=TE(I,K) ZE(I,K)=ZEM(I,K)-W(I,K) ZEM(I,K)=ZE(I,K) DI(I,K)=DIM(I,K)-X(I,K) DIM(I,K)=DI(I,K) 70 CONTINUE WRITE(6,105)ITER 105 FORMAT(1H0,'CHANGES AT ITERATION ',I2) CALL RMS(Z,X,W,Y) WRITE(6,106)ITER 106 FORMAT(1H0,'INITIALIZED VALUES AT ITERATION ',I2) CALL RMS( Q,DI,ZE,TE) 2000 CONTINUE RETURN END