Changeset 1418 for LMDZ4/trunk/libf/dyn3d
- Timestamp:
- Jul 19, 2010, 5:11:24 PM (14 years ago)
- Location:
- LMDZ4/trunk/libf/dyn3d
- Files:
-
- 1 edited
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/dyn3d/conf_gcm.F
r1403 r1418 54 54 LOGICAL fxyhypbb, ysinuss 55 55 INTEGER i 56 56 LOGICAL use_filtre_fft 57 57 c 58 58 c ------------------------------------------------------------------- … … 795 795 CALL getin('ok_dyn_ave',ok_dyn_ave) 796 796 797 !Config Key = use_filtre_fft 798 !Config Desc = flag d'activation des FFT pour le filtre 799 !Config Def = false 800 !Config Help = permet d'activer l'utilisation des FFT pour effectuer 801 !Config le filtrage aux poles. 802 ! Le filtre fft n'est pas implemente dans dyn3d 803 use_filtre_fft=.FALSE. 804 CALL getin('use_filtre_fft',use_filtre_fft) 805 806 IF (use_filtre_fft) THEN 807 write(lunout,*)'STOP !!!' 808 write(lunout,*)'use_filtre_fft n est pas implemente dans dyn3d' 809 STOP 810 ENDIF 811 797 812 !Config key = ok_strato 798 813 !Config Desc = activation de la version strato -
LMDZ4/trunk/libf/dyn3d/pres2lev.F90
r1417 r1418 1 1 ! $Id$ 2 2 ! 3 c****************************************************** 4 SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn, 5 % ni,nj,ok_invertp) 6 c 7 c interpolation lineaire pour passer 8 c a une nouvelle discretisation verticale pour 9 c les variables de GCM 10 c Francois Forget (01/1995) 11 c MOdif remy roca 12/97 pour passer de pres2sig 12 c Modif F.Codron 07/08 po en 3D 13 c********************************************************** 3 !****************************************************** 4 SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn,ni,nj,ok_invertp) 5 ! 6 ! interpolation lineaire pour passer 7 ! a une nouvelle discretisation verticale pour 8 ! les variables de GCM 9 ! Francois Forget (01/1995) 10 ! MOdif remy roca 12/97 pour passer de pres2sig 11 ! Modif F.Codron 07/08 po en 3D 12 !********************************************************** 14 13 15 14 IMPLICIT NONE 16 15 17 c Declarations: 18 c ============== 19 c 20 c ARGUMENTS 21 c """"""""" 22 LOGICAL, INTENT(IN) :: ok_invertp 23 INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches 24 INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches 25 INTEGER lmomx ! dimensions ancienne couches 26 INTEGER lmnmx ! dimensions nouvelle couches 16 ! Declarations: 17 ! ============== 18 ! 19 ! ARGUMENTS 20 ! """"""""" 21 LOGICAL, INTENT(IN) :: ok_invertp 22 INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches 23 INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches 24 25 REAL, INTENT(IN) :: po(ni*nj,lmo) ! niveau de pression ancienne grille 26 REAL, INTENT(IN) :: pn(ni*nj,lmn) ! niveau de pression nouvelle grille 27 27 28 parameter(lmomx=10000,lmnmx=10000)28 INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal 29 29 30 real, INTENT(IN) :: po(ni,nj,lmo) ! niveau de pressionancienne grille31 real, INTENT(IN) :: pn(ni,nj,lmn) ! niveau de pressionnouvelle grille30 REAL, INTENT(IN) :: varo(ni*nj,lmo) ! var dans l'ancienne grille 31 REAL, INTENT(OUT) :: varn(ni*nj,lmn) ! var dans la nouvelle grille 32 32 33 INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontale33 REAL :: zvaro(ni*nj,lmo),zpo(ni*nj,lmo) 34 34 35 REAL, INTENT(IN) :: varo(ni,nj,lmo) ! var dans l'ancienne grille 36 REAL, INTENT(OUT) :: varn(ni,nj,lmn) ! var dans la nouvelle grille 35 ! Autres variables 36 ! """""""""""""""" 37 INTEGER :: ln ,lo, k 38 REAL :: coef 37 39 38 real zvaro(lmomx),zpo(lmomx)39 40 40 c Autres variables 41 c """""""""""""""" 42 INTEGER n, ln ,lo, i, j, Nhoriz 43 REAL coef 41 ! Inversion de l'ordre des niveaux verticaux 42 IF (ok_invertp) THEN 43 DO lo=1,lmo 44 DO k=1,ni*nj 45 zpo(k,lo)=po(k,lmo+1-lo) 46 zvaro(k,lo)=varo(k,lmo+1-lo) 47 ENDDO 48 ENDDO 49 ELSE 50 DO lo=1,lmo 51 DO k=1,ni*nj 52 zpo(k,lo)=po(k,lo) 53 zvaro(k,lo)=varo(k,lo) 54 ENDDO 55 ENDDO 56 ENDIF 44 57 45 c run 46 c ==== 47 do i=1,ni 48 do j=1,nj 49 ! Inversion de l'ordre des niveaux verticaux 50 IF (ok_invertp) THEN 51 do lo=1,lmo 52 zpo(lo)=po(i,j,lmo+1-lo) 53 zvaro(lo)=varo(i,j,lmo+1-lo) 54 enddo 55 ELSE 56 do lo=1,lmo 57 zpo(lo)=po(i,j,lo) 58 zvaro(lo)=varo(i,j,lo) 59 enddo 60 ENDIF 58 DO ln=1,lmn 59 DO lo=1,lmo-1 60 DO k=1,ni*nj 61 IF (pn(k,ln) >= zpo(k,1) ) THEN 62 varn(k,ln) = zvaro(k,1) 63 ELSE IF (pn(k,ln) <= zpo(k,lmo)) THEN 64 varn(k,ln) = zvaro(k,lmo) 65 ELSE IF ( pn(k,ln) <= zpo(k,lo) .AND. pn(k,ln) > zpo(k,lo+1) ) THEN 66 coef = (pn(k,ln)-zpo(k,lo)) / (zpo(k,lo+1)-zpo(k,lo)) 67 varn(k,ln) = zvaro(k,lo) + coef*(zvaro(k,lo+1)-zvaro(k,lo)) 68 ENDIF 69 70 ENDDO 71 ENDDO 72 ENDDO 61 73 62 do ln=1,lmn 63 if (pn(i,j,ln).ge.zpo(1))then 64 varn(i,j,ln) = zvaro(1) 65 else if (pn(i,j,ln).le.zpo(lmo)) then 66 varn(i,j,ln) = zvaro(lmo) 67 else 68 do lo=1,lmo-1 69 if ( (pn(i,j,ln).le.zpo(lo)).and. 70 & (pn(i,j,ln).gt.zpo(lo+1)) )then 71 coef=(pn(i,j,ln)-zpo(lo)) 72 & /(zpo(lo+1)-zpo(lo)) 73 varn(i,j,ln)=zvaro(lo) 74 & +coef*(zvaro(lo+1)-zvaro(lo)) 75 c print*,'pn(',ln,')=',pn(i,j,ln),varn(i,j,ln) 76 end if 77 enddo 78 endif 79 enddo 80 81 enddo 82 enddo 83 return 84 end 74 END SUBROUTINE pres2lev
Note: See TracChangeset
for help on using the changeset viewer.