Changeset 3043 for branches/2011/dev_r2787_MERCATOR2_tidalharm
- Timestamp:
- 2011-11-04T10:08:18+01:00 (13 years ago)
- Location:
- branches/2011/dev_r2787_MERCATOR2_tidalharm/NEMOGCM/NEMO/OPA_SRC/DIA
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2787_MERCATOR2_tidalharm/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
r3042 r3043 234 234 nhan = (nitend_han-nit000_han+1)/nstep_han ! Number of dumps used for analysis 235 235 236 NBINCO= 2*nb_ana236 ninco = 2*nb_ana 237 237 238 238 ksp = 0 … … 246 246 kun = kun + 1 247 247 ksp = ksp + 1 248 ISPARSE(ksp) = keq249 JSPARSE(ksp) = kun250 SPARSEVALUE(ksp)= &248 nisparse(ksp) = keq 249 njsparse(ksp) = kun 250 valuesparse(ksp)= & 251 251 +( MOD(jc,2) * ft(jh) * COS(ana_freq(jh)*ztime + vt(jh) + ut(jh)) & 252 252 +(1.-MOD(jc,2))* ft(jh) * SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh))) … … 255 255 END DO 256 256 257 NBSPARSE=ksp257 nsparse=ksp 258 258 259 259 ! Elevation: … … 265 265 DO jc = 1,2 266 266 kun = kun + 1 267 TAB4(kun)=ana_temp(ji,jj,kun,1)267 tmp4(kun)=ana_temp(ji,jj,kun,1) 268 268 ENDDO 269 269 ENDDO … … 273 273 ! Fill output array 274 274 DO jh = 1, nb_ana 275 ana_amp(ji,jj,jh,1)= TAB7((jh-1)*2+1)276 ana_amp(ji,jj,jh,2)= TAB7((jh-1)*2+2)275 ana_amp(ji,jj,jh,1)=tmp7((jh-1)*2+1) 276 ana_amp(ji,jj,jh,2)=tmp7((jh-1)*2+2) 277 277 END DO 278 278 END DO … … 303 303 DO jc = 1,2 304 304 kun = kun + 1 305 TAB4(kun)=ana_temp(ji,jj,kun,2)305 tmp4(kun)=ana_temp(ji,jj,kun,2) 306 306 ENDDO 307 307 ENDDO … … 311 311 ! Fill output array 312 312 DO jh = 1, nb_ana 313 ana_amp(ji,jj,jh,1)= TAB7((jh-1)*2+1)314 ana_amp(ji,jj,jh,2)= TAB7((jh-1)*2+2)313 ana_amp(ji,jj,jh,1)=tmp7((jh-1)*2+1) 314 ana_amp(ji,jj,jh,2)=tmp7((jh-1)*2+2) 315 315 END DO 316 316 … … 337 337 DO jc = 1,2 338 338 kun = kun + 1 339 TAB4(kun)=ana_temp(ji,jj,kun,3)339 tmp4(kun)=ana_temp(ji,jj,kun,3) 340 340 ENDDO 341 341 ENDDO … … 345 345 ! Fill output array 346 346 DO jh = 1, nb_ana 347 ana_amp(ji,jj,jh,1)= TAB7((jh-1)*2+1)348 ana_amp(ji,jj,jh,2)= TAB7((jh-1)*2+2)347 ana_amp(ji,jj,jh,1)=tmp7((jh-1)*2+1) 348 ana_amp(ji,jj,jh,2)=tmp7((jh-1)*2+2) 349 349 END DO 350 350 -
branches/2011/dev_r2787_MERCATOR2_tidalharm/NEMOGCM/NEMO/OPA_SRC/DIA/surdetermine.F90
r2956 r3043 6 6 PUBLIC 7 7 8 INTEGER, PARAMETER :: NBINCOMAX= 189 INTEGER, PARAMETER :: DIMSPARSE = NBINCOMAX*300*248 INTEGER, PARAMETER :: jpincomax = 18 9 INTEGER, PARAMETER :: jpdimsparse = jpincomax*300*24 10 10 11 INTEGER :: NBSPARSE, NBINCO12 REAL(wp), DIMENSION(DIMSPARSE) :: SPARSEVALUE13 INTEGER , DIMENSION(DIMSPARSE) :: JSPARSE , ISPARSE11 INTEGER, PUBLIC :: nsparse, ninco 12 REAL(wp), PUBLIC, DIMENSION(jpdimsparse) :: valuesparse 13 INTEGER , PUBLIC, DIMENSION(jpdimsparse) :: njsparse, nisparse 14 14 15 INTEGER, SAVE, DIMENSION( NBINCOMAX) :: JPOS116 REAL(wp), DIMENSION( NBINCOMAX) :: TAB4, TAB717 REAL(wp), SAVE, DIMENSION( NBINCOMAX,NBINCOMAX) :: TAB3, PILIER18 REAL(wp), SAVE, DIMENSION( NBINCOMAX) :: PIVOT15 INTEGER, SAVE, DIMENSION(jpincomax) :: ipos1 16 REAL(wp), DIMENSION(jpincomax) :: tmp4, tmp7 17 REAL(wp), SAVE, DIMENSION(jpincomax,jpincomax) :: ztmp3, zpilier 18 REAL(wp), SAVE, DIMENSION(jpincomax) :: zpivot 19 19 20 20 !!--------------------------------------------------------------------------------- … … 29 29 30 30 INTEGER :: & 31 I_SD, I1_SD, II_SD, J_SD, K1_SD, K2_SD32 REAL(wp) :: VALEUR1, VALEUR2, X133 REAL(wp), DIMENSION( NBINCOMAX) :: TABX, COL1, COL234 INTEGER, DIMENSION( NBINCOMAX) :: JPOS2, JPIVOT31 ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd 32 REAL(wp) :: zval1, zval2, zx1 33 REAL(wp), DIMENSION(jpincomax) :: ztmpx, zcol1, zcol2 34 INTEGER, DIMENSION(jpincomax) :: ipos2, ipivot 35 35 !--------------------------------------------------------------------------------- 36 36 37 37 IF (init==1) THEN 38 IF( NBSPARSE.GT.DIMSPARSE) STOP 'surdetermine erreur1'39 IF( NBINCO.GT.NBINCOMAX)THEN40 IF (lwp) WRITE(numout,*)' NBINCO =',NBINCO41 IF (lwp) WRITE(numout,*)' NBINCOMAX=',NBINCOMAX38 IF(nsparse .gt. jpdimsparse) STOP 'surdetermine erreur1' 39 IF(ninco .gt. jpincomax)THEN 40 IF (lwp) WRITE(numout,*)'ninco =',ninco 41 IF (lwp) WRITE(numout,*)'jpincomax=',jpincomax 42 42 STOP 'DONC dans surdetermine erreur2' 43 43 END IF 44 44 45 TAB3(:,:)=0.e045 ztmp3(:,:)=0.e0 46 46 47 DO K1_SD=1,NBSPARSE48 DO K2_SD=1,NBSPARSE49 ISPARSE(K2_SD)=ISPARSE(K2_SD)50 JSPARSE(K2_SD)=JSPARSE(K2_SD)51 IF( ISPARSE(K2_SD).EQ.ISPARSE(K1_SD)) &52 TAB3(JSPARSE(K1_SD),JSPARSE(K2_SD))= &53 TAB3(JSPARSE(K1_SD),JSPARSE(K2_SD)) &54 + SPARSEVALUE(K1_SD)*SPARSEVALUE(K2_SD)47 DO jk1_sd=1,nsparse 48 DO jk2_sd=1,nsparse 49 nisparse(jk2_sd)=nisparse(jk2_sd) 50 njsparse(jk2_sd)=njsparse(jk2_sd) 51 IF(nisparse(jk2_sd) .eq. nisparse(jk1_sd)) & 52 ztmp3(njsparse(jk1_sd),njsparse(jk2_sd))= & 53 ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) & 54 +valuesparse(jk1_sd)*valuesparse(jk2_sd) 55 55 END DO 56 56 END DO 57 57 58 DO J_SD=1,NBINCO59 JPOS1(J_SD)=J_SD60 JPOS2(J_SD)=J_SD58 DO jj_sd=1,ninco 59 ipos1(jj_sd)=jj_sd 60 ipos2(jj_sd)=jj_sd 61 61 ENDDO 62 62 63 DO I_SD=1,NBINCO63 DO ji_sd=1,ninco 64 64 ! recherche du plus grand pivot non nul 65 VALEUR1=ABS(TAB3(I_SD,I_SD))65 zval1=ABS(ztmp3(ji_sd,ji_sd)) 66 66 67 JPIVOT(I_SD)=I_SD68 DO J_SD=I_SD,NBINCO69 VALEUR2=ABS(TAB3(I_SD,J_SD))70 IF( VALEUR2.GE.VALEUR1) THEN71 JPIVOT(I_SD)=J_SD72 VALEUR1=VALEUR267 ipivot(ji_sd)=ji_sd 68 DO jj_sd=ji_sd,ninco 69 zval2=ABS(ztmp3(ji_sd,jj_sd)) 70 IF(zval2.GE.zval1) THEN 71 ipivot(ji_sd)=jj_sd 72 zval1=zval2 73 73 ENDIF 74 74 END DO 75 75 76 DO I1_SD=1,NBINCO77 COL1(I1_SD)=TAB3(I1_SD,I_SD)78 COL2(I1_SD)=TAB3(I1_SD,JPIVOT(I_SD))79 TAB3(I1_SD,I_SD)=COL2(I1_SD)80 TAB3(I1_SD,JPIVOT(I_SD))=COL1(I1_SD)76 DO ji1_sd=1,ninco 77 zcol1(ji1_sd)=ztmp3(ji1_sd,ji_sd) 78 zcol2(ji1_sd)=ztmp3(ji1_sd,ipivot(ji_sd)) 79 ztmp3(ji1_sd,ji_sd)=zcol2(ji1_sd) 80 ztmp3(ji1_sd,ipivot(ji_sd))=zcol1(ji1_sd) 81 81 END DO 82 82 83 JPOS2(I_SD)=JPOS1(JPIVOT(I_SD))84 JPOS2(JPIVOT(I_SD))=JPOS1(I_SD)85 JPOS1(I_SD)=JPOS2(I_SD)86 JPOS1(JPIVOT(I_SD))=JPOS2(JPIVOT(I_SD))83 ipos2(ji_sd)=ipos1(ipivot(ji_sd)) 84 ipos2(ipivot(ji_sd))=ipos1(ji_sd) 85 ipos1(ji_sd)=ipos2(ji_sd) 86 ipos1(ipivot(ji_sd))=ipos2(ipivot(ji_sd)) 87 87 88 88 89 89 !------------------------------- 90 PIVOT(I_SD)=TAB3(I_SD,I_SD)91 DO J_SD=1,NBINCO92 TAB3(I_SD,J_SD)=TAB3(I_SD,J_SD)/PIVOT(I_SD)90 zpivot(ji_sd)=ztmp3(ji_sd,ji_sd) 91 DO jj_sd=1,ninco 92 ztmp3(ji_sd,jj_sd)=ztmp3(ji_sd,jj_sd)/zpivot(ji_sd) 93 93 END DO 94 94 !------------------------------- 95 95 96 96 !------------------------------- 97 DO II_SD=I_SD+1,NBINCO98 PILIER(II_SD,I_SD)=TAB3(II_SD,I_SD)99 DO J_SD=1,NBINCO100 TAB3(II_SD,J_SD)= &101 TAB3(II_SD,J_SD)-TAB3(I_SD,J_SD)*PILIER(II_SD,I_SD)97 DO ji2_sd=ji_sd+1,ninco 98 zpilier(ji2_sd,ji_sd)=ztmp3(ji2_sd,ji_sd) 99 DO jj_sd=1,ninco 100 ztmp3(ji2_sd,jj_sd)= & 101 ztmp3(ji2_sd,jj_sd)-ztmp3(ji_sd,jj_sd)*zpilier(ji2_sd,ji_sd) 102 102 END DO 103 103 END DO … … 108 108 109 109 ! 110 DO I_SD=1,NBINCO111 TAB4(I_SD)=TAB4(I_SD)/PIVOT(I_SD)112 DO II_SD=I_SD+1,NBINCO113 TAB4(II_SD)=TAB4(II_SD)-TAB4(I_SD)*PILIER(II_SD,I_SD)110 DO ji_sd=1,ninco 111 tmp4(ji_sd)=tmp4(ji_sd)/zpivot(ji_sd) 112 DO ji2_sd=ji_sd+1,ninco 113 tmp4(ji2_sd)=tmp4(ji2_sd)-tmp4(ji_sd)*zpilier(ji2_sd,ji_sd) 114 114 END DO 115 115 END DO 116 116 117 117 ! resolution du systeme: 118 TABX(NBINCO)=TAB4(NBINCO)/TAB3(NBINCO,NBINCO)119 I_SD=NBINCO120 DO I_SD=NBINCO-1,1,-1121 X1=0.122 DO J_SD=I_SD+1,NBINCO123 X1=X1+TABX(J_SD)*TAB3(I_SD,J_SD)118 ztmpx(ninco)=tmp4(ninco)/ztmp3(ninco,ninco) 119 ji_sd=ninco 120 DO ji_sd=ninco-1,1,-1 121 zx1=0. 122 DO jj_sd=ji_sd+1,ninco 123 zx1=zx1+ztmpx(jj_sd)*ztmp3(ji_sd,jj_sd) 124 124 END DO 125 TABX(I_SD)=TAB4(I_SD)-X1125 ztmpx(ji_sd)=tmp4(ji_sd)-zx1 126 126 END DO 127 127 128 DO J_SD=1,NBINCO129 TAB7(JPOS1(J_SD))=TABX(J_SD)128 DO jj_sd=1,ninco 129 tmp7(ipos1(jj_sd))=ztmpx(jj_sd) 130 130 END DO 131 131
Note: See TracChangeset
for help on using the changeset viewer.