!-------------------------------------- LICENCE BEGIN ------------------------------------ !Environment Canada - Atmospheric Science and Technology License/Disclaimer, ! version 3; Last Modified: May 7, 2008. !This is free but copyrighted software; you can use/redistribute/modify it under the terms !of the Environment Canada - Atmospheric Science and Technology License/Disclaimer !version 3 or (at your option) any later version that should be found at: !http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html ! !This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; !without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. !See the above mentioned License/Disclaimer for more details. !You should have received a copy of the License/Disclaimer along with this software; !if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), !CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca !-------------------------------------- LICENCE END -------------------------------------- !SUBROUTINE M1QN2 (SIMUL,PROSCA,N,X,F,G,DXMIN,DF1,EPSG,IMPRES,IO,,1 / MODE,NITER,NSIM,RZ,NRZ,IZS,RZS,DZS) C---- C C M1QN2, VERSION 1.1, FEVRIER 1989. C JEAN CHARLES GILBERT, CLAUDE LEMARECHAL, INRIA. C C UTILISE LES SOUS-ROUTINES: C M1QN2A C DD1 C MLIS0 + ECUBE (XII/88) C C LA SOUS-ROUTINE M1QN2 EST UNE INTERFACE ENTRE LE PROGRAMME C APPELANT ET LA SOUS-ROUTINE M1QN2A, LE MINIMISEUR PROPREMENT DIT. C C RZ EST LA ZONE DE TRAVAIL POUR M1QN2A, DE DIMENSION NRZ. C ELLE EST SUBDIVISEE EN C 3 VECTEURS DE DIMENSION N: D,GG,AUX C M SCALAIRES: ALPHA C M VECTEURS DE DIMENSION N: YBAR C M VECTEURS DE DIMENSION N: SBAR C C M EST ALORS LE PLUS GRAND ENTIER TEL QUE C M*(2*N+1)+3*N .LE. NRZ, C SOIT M := (NRZ-3*N) / (2*N+1) C IL FAUT AVOIR M >= 1, DONC NRZ >= 5N+1. C C LA MATRICE INITIALE DE MISE A JOUR EST UN MULTIPLE DE L'IDENTITE. C ON UTILISE LE FACTEUR D'OREN-SPEDICATO (PRECON): C (Y,S)/(Y,Y) C C---- C C ARGUMENTS C INTEGER N,IMPRES,IO,MODE,NITER,NSIM,NRZ,IZS(1) REAL*8 X(1),F,G(1),DXMIN,DF1,EPSG,RZ(1),RZS(1) DOUBLE PRECISION DZS(1) EXTERNAL SIMUL,PROSCA C C VARIABLES LOCALES C INTEGER M,NRZU,L1MEMO,ID,IGG,IAUX,IALPHA,IYBAR,ISBAR REAL*8 R1,R2 DOUBLE PRECISION PS C C---- IMPRESSIONS INITIALES ET CONTROLE DES ARGUMENTS C IF (IMPRES.GE.1) / WRITE (IO,900) N,DXMIN,DF1,EPSG,NITER,NSIM,IMPRES 900 FORMAT (/" M1QN2 (VERSION 1.1, FEBRUARY 1989): ENTRY POINT"/ / 5X,"DIMENSION OF THE PROBLEM (N):",I6/ / 5X,"ABSOLUTE PRECISION ON X (DXMIN):",E9.2/ / 5X,"EXPECTED DECREASE FOR F (DF1):",E9.2/ / 5X,"RELATIVE PRECISION ON G (EPSG):",E9.2/ / 5X,"MAXIMAL NUMBER OF ITERATIONS (NITER):",I6/ / 5X,"MAXIMAL NUMBER OF SIMULATIONS (NSIM):",I6/ / 5X,"PRINTING LEVEL (IMPRES):",I4) IF (N.LE.0.OR.NITER.LE.0.OR.NSIM.LE.0.OR.DXMIN.LE.0..OR.EPSG.LE.0. / .OR.EPSG.GT.1.) THEN MODE=2 IF (IMPRES.GE.1) WRITE (IO,901) 901 FORMAT (/" >>> M1QN2: INCONSISTENT CALL") GOTO 904 ENDIF IF (NRZ.LT.5*N+1) THEN MODE=2 IF (IMPRES.GE.1) WRITE (IO,902) 902 FORMAT (/" >>> M1QN2: NOT ENOUGH MEMORY ALLOCATED") GOTO 904 ENDIF C C---- CALCUL DE M ET DES POINTEURS SUBDIVISANT LA ZONE DE TRAVAIL RZ C NRZU=NRZ-3*N L1MEMO=2*N+1 M=NRZU/L1MEMO NRZU=M*L1MEMO+3*N IF (IMPRES.GE.1) WRITE (IO,903) NRZ,NRZU,M 903 FORMAT (/5X,"ALLOCATED MEMORY (NRZ) :",I7/ / 5X,"USED MEMORY : ",I7/ / 5X,"NUMBER OF UPDATES : ",I7/1X) ID=1 IGG=ID+N IAUX=IGG+N IALPHA=IAUX+N IYBAR=IALPHA+M ISBAR=IYBAR+N*M C C---- APPEL DU CODE D"OPTIMISATION C CALL M1QN2A
(SIMUL,PROSCA,N,X,F,G,DXMIN,DF1,EPSG, / IMPRES,IO,MODE,NITER,NSIM,M, / RZ(ID),RZ(IGG),RZ(IAUX), / RZ(IALPHA),RZ(IYBAR),RZ(ISBAR),IZS,RZS,DZS) C C---- IMPRESSIONS FINALES C 904 CONTINUE IF (IMPRES.GE.1) WRITE (IO,905) MODE,NITER,NSIM,EPSG 905 FORMAT (/1X,79("-")/ / /" M1QN2: OUTPUT MODE IS ",I2 / /5X,"NUMBER OF ITERATIONS: ",I4 / /5X,"NUMBER OF SIMULATIONS: ",I6 / /5X,"REALIZED RELATIVE PRECISION ON G: ",E9.2) CALL PROSCA (N,X,X,PS,IZS,RZS,DZS) R1=SNGL(PS) R1=SQRT(R1) CALL PROSCA (N,G,G,PS,IZS,RZS,DZS) R2=SNGL(PS) R2=SQRT(R2) IF (IMPRES.GE.1) WRITE (IO,906) R1,F,R2 906 FORMAT (5X,"NORM OF X = ",E15.8 / /5X,"F = ",E15.8 / /5X,"NORM OF G = ",E15.8) RETURN END