! $Header$ SUBROUTINE test_period( ucov, vcov, teta, q, p, phis ) ! ! Auteur : P. Le Van ! --------- ! .... Cette routine teste la periodicite en longitude des champs ucov, ! teta, q , p et phis .......... ! USE infotrac, ONLY: nqtot ! ! IMPLICIT NONE ! INCLUDE "dimensions.h" INCLUDE "paramet.h" ! ! ...... Arguments ...... ! REAL :: ucov(ip1jmp1,llm), vcov(ip1jm,llm), teta(ip1jmp1,llm) , & q(ip1jmp1,llm,nqtot), p(ip1jmp1,llmp1), phis(ip1jmp1) ! ! ..... Variables locales ..... ! INTEGER :: ij,l,nq ! DO l = 1, llm DO ij = 1, ip1jmp1, iip1 IF( ucov(ij,l)/=ucov(ij+iim,l) ) THEN PRINT *,'STOP dans test_period car --- UCOV --- n est pas', & ' periodique en longitude ! ' PRINT *,' l, ij = ', l, ij, ij+iim STOP ENDIF IF( teta(ij,l)/=teta(ij+iim,l) ) THEN PRINT *,'STOP dans test_period car --- TETA --- n est pas', & ' periodique en longitude ! ' PRINT *,' l, ij = ', l, ij, ij+iim & , teta(ij,l), teta(ij+iim,l) STOP ENDIF ENDDO do ij=1,iim if (teta(ij,l)/=teta(1,l) & .or.teta(ip1jm+ij,l)/=teta(ip1jm+1,l) ) THEN PRINT *,'STOP dans test_period car --- TETA --- n est pas', & ' constant aux poles ! ' PRINT*,'teta(',1 ,',',l,')=',teta(1 ,l) PRINT*,'teta(',ij,',',l,')=',teta(ij,l) PRINT*,'teta(',ip1jm+1 ,',',l,')=',teta(ip1jm+1 ,l) PRINT*,'teta(',ip1jm+ij,',',l,')=',teta(ip1jm+ij,l) stop endif enddo ENDDO ! DO l = 1, llm DO ij = 1, ip1jm, iip1 IF( vcov(ij,l)/=vcov(ij+iim,l) ) THEN PRINT *,'STOP dans test_period car --- VCOV --- n est pas', & ' periodique en longitude !' PRINT *,' l, ij = ', l, ij, ij+iim,vcov(ij+iim,l),vcov(ij,l) vcov(ij+iim,l)=vcov(ij,l) ! STOP ENDIF ENDDO ENDDO ! DO nq =1, nqtot DO l =1, llm DO ij = 1, ip1jmp1, iip1 IF( q(ij,l,nq)/=q(ij+iim,l,nq) ) THEN PRINT *,'STOP dans test_period car --- Q --- n est pas ', & 'periodique en longitude !' PRINT *,' nq , l, ij = ', nq, l, ij, ij+iim STOP ENDIF ENDDO ENDDO ENDDO ! DO l = 1, llm DO ij = 1, ip1jmp1, iip1 IF( p(ij,l)/=p(ij+iim,l) ) THEN PRINT *,'STOP dans test_period car --- P --- n est pas', & ' periodique en longitude !' PRINT *,' l ij = ',l, ij, ij+iim STOP ENDIF IF( phis(ij)/=phis(ij+iim) ) THEN PRINT *,'STOP dans test_period car --- PHIS --- n est pas', & ' periodique en longitude ! l, IJ = ', l, ij,ij+iim PRINT *,' ij = ', ij, ij+iim STOP ENDIF ENDDO do ij=1,iim if (p(ij,l)/=p(1,l) & .or.p(ip1jm+ij,l)/=p(ip1jm+1,l) ) THEN PRINT *,'STOP dans test_period car --- P --- n est pas', & ' constant aux poles ! ' PRINT*,'p(',1 ,',',l,')=',p(1 ,l) PRINT*,'p(',ij,',',l,')=',p(ij,l) PRINT*,'p(',ip1jm+1 ,',',l,')=',p(ip1jm+1 ,l) PRINT*,'p(',ip1jm+ij,',',l,')=',p(ip1jm+ij,l) stop endif enddo ENDDO ! ! RETURN END SUBROUTINE test_period