Changeset 658 for trunk/LMDZ.MARS/libf/aeronomars/moldiff.F
- Timestamp:
- May 12, 2012, 8:10:08 AM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/libf/aeronomars/moldiff.F
r414 r658 279 279 c Inverting the alfa matrix 280 280 c 281 call ludcmp (alf,ncompmoldiff-1,ncompmoldiff-1,indx,d,ierr)281 call ludcmp_sp(alf,ncompmoldiff-1,ncompmoldiff-1,indx,d,ierr) 282 282 283 283 c TEMPORAIRE ***************************** 284 284 if (ierr.ne.0) then 285 write(*,*) 'In moldiff: Problem in LUDCMP with matrix alf'285 write(*,*)'In moldiff: Problem in LUDCMP_SP with matrix alf' 286 286 write(*,*) 'Singular matrix ?' 287 287 c write(*,*) 'Matrix alf = ', alf … … 294 294 c ******************************************* 295 295 do n=1,ncompmoldiff-1 296 call lubksb (alf,ncompmoldiff-1,ncompmoldiff-1,indx,y(1,n))296 call lubksb_sp(alf,ncompmoldiff-1,ncompmoldiff-1,indx,y(1,n)) 297 297 do nn=1,ncompmoldiff-1 298 298 alfinv(l,nn,n)=y(nn,n)/hh … … 415 415 btri(1)=btri(1)+atri(1) 416 416 417 call tridag (atri,btri,ctri,rtri,qtri,nz-2)417 call tridag_sp(atri,btri,ctri,rtri,qtri,nz-2) 418 418 419 419 do l=2,nz-1 … … 464 464 c ******************************************************************** 465 465 466 subroutine tridag (a,b,c,r,u,n)467 parameter (nmax=100)466 subroutine tridag_sp(a,b,c,r,u,n) 467 c parameter (nmax=100) 468 468 c dimension gam(nmax),a(n),b(n),c(n),r(n),u(n) 469 real gam(n max),a(n),b(n),c(n),r(n),u(n)469 real gam(n),a(n),b(n),c(n),r(n),u(n) 470 470 if(b(1).eq.0.)then 471 stop 'tridag : error: b(1)=0 !!! '471 stop 'tridag_sp: error: b(1)=0 !!! ' 472 472 endif 473 473 bet=b(1) … … 477 477 bet=b(j)-a(j)*gam(j) 478 478 if(bet.eq.0.) then 479 stop 'tridag : error: bet=0 !!! '479 stop 'tridag_sp: error: bet=0 !!! ' 480 480 endif 481 481 u(j)=(r(j)-a(j)*u(j-1))/bet … … 491 491 c ******************************************************************** 492 492 493 SUBROUTINE LUBKSB (A,N,NP,INDX,B)493 SUBROUTINE LUBKSB_SP(A,N,NP,INDX,B) 494 494 495 495 implicit none … … 530 530 c ******************************************************************** 531 531 532 SUBROUTINE LUDCMP (A,N,NP,INDX,D,ierr)532 SUBROUTINE LUDCMP_SP(A,N,NP,INDX,D,ierr) 533 533 534 534 implicit none … … 550 550 11 CONTINUE 551 551 IF (AAMAX.EQ.0.) then 552 write(*,*) 'In moldiff: Problem in LUDCMP with matrix A'552 write(*,*) 'In moldiff: Problem in LUDCMP_SP with matrix A' 553 553 write(*,*) 'Singular matrix ?' 554 554 c write(*,*) 'Matrix A = ', A
Note: See TracChangeset
for help on using the changeset viewer.