Changeset 960
- Timestamp:
- May 27, 2008, 6:46:50 PM (17 years ago)
- Location:
- LMDZ4/trunk/libf
- Files:
-
- 18 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/dyn3d/advtrac.F
r762 r960 4 4 c 5 5 c 6 #ifdef INCA7 6 SUBROUTINE advtrac(pbaru,pbarv , 8 7 * p, masse,q,iapptrac,teta, 9 8 * flxw, 10 9 * pk) 11 #else12 SUBROUTINE advtrac(pbaru,pbarv ,13 * p, masse,q,iapptrac,teta,14 * pk)15 #endif16 10 c Auteur : F. Hourdin 17 11 c … … 48 42 REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm) 49 43 REAL pk(ip1jmp1,llm) 50 #ifdef INCA 51 REAL :: flxw(ip1jmp1,llm) 52 #endif 44 REAL flxw(ip1jmp1,llm) 53 45 54 46 c------------------------------------------------------------- … … 124 116 CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg ) 125 117 126 #ifdef INCA127 118 ! ... Flux de masse diaganostiques traceurs 128 119 flxw = wg / FLOAT(iapp_tracvl) 129 #endif130 120 131 121 c test sur l'eventuelle creation de valeurs negatives de la masse … … 209 199 else if (iadv(iq).eq.20) then 210 200 call pentes_ini (q(1,1,iq),wg,massem,pbarug,pbarvg,0) 211 #ifdef INCA212 do iiq = iq+1, iq+3213 c q(:,:,iiq)=q(:,:,iiq)*mmt_adj(:,:,1)214 q(:,:,iiq)=q(:,:,iiq)*1215 enddo216 #endif217 201 218 202 c ---------------------------------------------------------------- … … 228 212 call prather(q(1,1,iq),wg,massem,pbarug,pbarvg, 229 213 s n,dtbon) 230 #ifdef INCA 231 do iiq = iq+1, iq+9 232 c q(:,:,iiq)=q(:,:,iiq)*mmt_adj(:,:,1) 233 q(:,:,iiq)=q(:,:,iiq)*1 234 enddo 235 #endif 214 236 215 c ---------------------------------------------------------------- 237 216 c Schemas PPM Lin et Rood -
LMDZ4/trunk/libf/dyn3d/caladvtrac.F
r762 r960 4 4 c 5 5 c 6 #ifdef INCA7 6 SUBROUTINE caladvtrac(q,pbaru,pbarv , 8 7 * p ,masse, dq , teta, 9 * flxw, 10 * pk) 11 #else 12 SUBROUTINE caladvtrac(q,pbaru,pbarv , 13 * p ,masse, dq , teta, 14 * pk) 15 #endif 16 8 * flxw, pk) 17 9 c 18 10 IMPLICIT NONE … … 39 31 REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqmx),dq( ip1jmp1,llm,2 ) 40 32 REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm) 41 #ifdef INCA42 33 REAL :: flxw(ip1jmp1,llm) 43 #endif44 34 45 35 c .................................................................. … … 69 59 c advection 70 60 71 #ifdef INCA 72 CALL advtrac( pbaru,pbarv, 73 * p, masse,q,iapptrac, teta, 74 . flxw, 75 . pk) 76 #else 77 CALL advtrac( pbaru,pbarv, 78 * p, masse,q,iapptrac, teta, 79 . pk) 80 #endif 61 CALL advtrac( pbaru,pbarv, 62 * p, masse,q,iapptrac, teta, 63 . flxw, pk) 81 64 c 82 65 -
LMDZ4/trunk/libf/dyn3d/calfis.F
r956 r960 22 22 $ pdteta, 23 23 $ pdq, 24 $ pw,25 #ifdef INCA26 24 $ flxw, 27 #endif28 25 $ clesphy0, 29 26 $ pdufi, … … 121 118 REAL pdq(iip1,jjp1,llm,nqmx) 122 119 c 123 REAL pw(iip1,jjp1,llm)124 125 120 REAL pps(iip1,jjp1) 126 121 REAL pp(iip1,jjp1,llmp1) … … 151 146 REAL pcvgu(ngridmx,llm), pcvgv(ngridmx,llm) 152 147 REAL pcvgt(ngridmx,llm), pcvgq(ngridmx,llm,2) 153 c154 REAL pvervel(ngridmx,llm)155 148 c 156 149 REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm) … … 169 162 REAL PVteta(ngridmx,ntetaSTD) 170 163 c 171 #ifdef INCA 172 REAL flxw(iip1,jjp1,llm) 173 REAL flxwfi(ngridmx,llm) 174 #endif 164 REAL flxw(iip1,jjp1,llm) ! Flux de masse verticale sur la grille dynamique 165 REAL flxwfi(ngridmx,llm) ! Flux de masse verticale sur la grille physiq 175 166 c 176 167 … … 328 319 329 320 c .... Calcul de la vitesse verticale ( en Pa*m*s ou Kg/s ) .... 330 c 331 DO l=1,llm 332 pvervel(1,l)=pw(1,1,l) * g /apoln 333 ig0=2 334 DO j=2,jjm 335 DO i = 1, iim 336 pvervel(ig0,l) = pw(i,j,l) * g * unsaire(i,j) 337 ig0 = ig0 + 1 338 ENDDO 339 ENDDO 340 pvervel(ig0,l)=pw(1,jjp1,l) * g /apols 341 ENDDO 321 c JG : ancien calcule de omega utilise dans physiq.F. Maintenant le flux 322 c de masse est calclue dans advtrac.F 323 c DO l=1,llm 324 c pvervel(1,l)=pw(1,1,l) * g /apoln 325 c ig0=2 326 c DO j=2,jjm 327 c DO i = 1, iim 328 c pvervel(ig0,l) = pw(i,j,l) * g * unsaire(i,j) 329 c ig0 = ig0 + 1 330 c ENDDO 331 c ENDDO 332 c pvervel(ig0,l)=pw(1,jjp1,l) * g /apols 333 c ENDDO 342 334 343 335 c … … 442 434 $ ntetaSTD,rtetaSTD,PVteta) 443 435 c 444 #ifdef INCA 436 c On change de grille, dynamique vers physiq, pour le flux de masse verticale 445 437 CALL gr_dyn_fi(llm,iip1,jjp1,ngridmx,flxw,flxwfi) 446 #endif447 448 438 449 439 c----------------------------------------------------------------------- … … 470 460 . ztfi, 471 461 . zqfi, 472 . pvervel,473 #ifdef INCA474 462 . flxwfi, 475 #endif476 463 . zdufi, 477 464 . zdvfi, -
LMDZ4/trunk/libf/dyn3d/conf_gcm.F
r956 r960 507 507 offline = .FALSE. 508 508 CALL getin('offline',offline) 509 510 !Config Key = config_inca 511 !Config Desc = Choix de configuration de INCA 512 !Config Def = none 513 !Config Help = Choix de configuration de INCA : 514 !Config 'none' = sans INCA 515 !Config 'chem' = INCA avec calcul de chemie 516 !Config 'aero' = INCA avec calcul des aerosols 517 config_inca = 'none' 518 CALL getin('config_inca',config_inca) 509 519 510 520 … … 541 551 write(lunout,*)' tauyy = ', tauyy 542 552 write(lunout,*)' offline = ', offline 553 write(lunout,*)' config_inca = ', config_inca 543 554 544 555 RETURN … … 653 664 offline = .FALSE. 654 665 CALL getin('offline',offline) 655 write(lunout,*)' offline = ', offline 656 666 667 !Config Key = config_inca 668 !Config Desc = Choix de configuration de INCA 669 !Config Def = none 670 !Config Help = Choix de configuration de INCA : 671 !Config 'none' = sans INCA 672 !Config 'chem' = INCA avec calcul de chemie 673 !Config 'aero' = INCA avec calcul des aerosols 674 config_inca = 'none' 675 CALL getin('config_inca',config_inca) 657 676 658 677 write(lunout,*)' #########################################' … … 688 707 write(lunout,*)' tauy = ', tauy 689 708 write(lunout,*)' offline = ', offline 709 write(lunout,*)' config_inca = ', config_inca 690 710 c 691 711 RETURN -
LMDZ4/trunk/libf/dyn3d/control.h
r956 r960 14 14 & iperiod,iapp_tracvl,iconser,iecri,idissip,iphysiq , & 15 15 & periodav,iecrimoy,dayref,anneeref, & 16 & raz_date,offline,ip_ebil_dyn 16 & raz_date,offline,ip_ebil_dyn,config_inca 17 17 18 18 INTEGER nday,day_step,iperiod,iapp_tracvl,iconser,iecri, & … … 21 21 REAL periodav 22 22 logical offline 23 23 CHARACTER*4 config_inca 24 24 !----------------------------------------------------------------------- -
LMDZ4/trunk/libf/dyn3d/create_etat0_limit.F
r822 r960 29 29 #include "indicesol.h" 30 30 #include "advtrac.h" 31 cym#include "dimphy.h" 31 #include "control.h" 32 32 REAL :: masque(iip1,jjp1) 33 33 REAL :: pctsrf(iim*(jjm-1)+2, nbsrf) … … 43 43 mmt_adj(:,:,:,:) = 1 44 44 45 IF (config_inca /= 'none') THEN 45 46 #ifdef INCA 46 call init_const_lmdz(nbtrac,anneeref,dayref,iphysiq,day_step,nday) 47 print *, 'nbtrac =' , nbtrac 47 call init_const_lmdz(nbtrac,anneeref,dayref,iphysiq,day_step,nday) 48 48 #endif 49 print *, 'nbtrac =' , nbtrac 50 END IF 49 51 50 52 CALL Init_Phys_lmdz(iim,jjp1,llm,nqmx-2,1,(jjm-1)*iim+2) -
LMDZ4/trunk/libf/dyn3d/dynredem.F
r822 r960 521 521 #include "advtrac.h" 522 522 #include "temps.h" 523 #include "control.h" 523 524 524 525 INTEGER nq, l … … 623 624 #endif 624 625 625 #ifdef INCA 626 IF (config_inca /= 'none') THEN 626 627 ! Ajout Anne pour lecture valeurs traceurs dans un fichier start_trac.nc 627 ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac)628 IF (ierr_file .NE.NF_NOERR) THEN629 write(6,*)' Pb d''ouverture du fichier start_trac.nc'630 write(6,*)' ierr = ', ierr_file631 ENDIF632 #endif 628 ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac) 629 IF (ierr_file .NE.NF_NOERR) THEN 630 write(6,*)' Pb d''ouverture du fichier start_trac.nc' 631 write(6,*)' ierr = ', ierr_file 632 ENDIF 633 END IF 633 634 634 635 IF(nq.GE.1) THEN 635 do iq=1,nq 636 #ifdef INCA 636 do iq=1,nq 637 638 IF (config_inca == 'none') THEN 639 ierr = NF_INQ_VARID(nid, tname(iq), nvarid) 640 IF (ierr .NE. NF_NOERR) THEN 641 PRINT*, "Variable tname(iq) n est pas definie" 642 CALL abort 643 ENDIF 644 #ifdef NC_DOUBLE 645 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq)) 646 #else 647 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) 648 #endif 649 ELSE ! config_inca = 'chem' ou 'aero' 637 650 ! lecture de la valeur du traceur dans start_trac.nc 638 if (ierr_file .ne. 2) then639 ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)640 IF (ierr .NE. NF_NOERR) THEN641 PRINT*, tname(iq),"est absent de start_trac.nc"642 ierr = NF_INQ_VARID(nid, tname(iq), nvarid)643 IF (ierr .NE. NF_NOERR) THEN644 PRINT*, "Variable ", tname(iq)," n est pas definie"645 CALL abort646 ENDIF647 #ifdef NC_DOUBLE 648 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq))649 #else 650 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq))651 #endif 652 653 ELSE654 PRINT*, tname(iq), "est present dans start_trac.nc"651 IF (ierr_file .ne. 2) THEN 652 ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac) 653 IF (ierr .NE. NF_NOERR) THEN 654 PRINT*, tname(iq),"est absent de start_trac.nc" 655 ierr = NF_INQ_VARID(nid, tname(iq), nvarid) 656 IF (ierr .NE. NF_NOERR) THEN 657 PRINT*, "Variable ", tname(iq)," n est pas definie" 658 CALL abort 659 ENDIF 660 #ifdef NC_DOUBLE 661 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq)) 662 #else 663 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) 664 #endif 665 666 ELSE 667 PRINT*, tname(iq), "est present dans start_trac.nc" 655 668 #ifdef NC_DOUBLE 656 669 ierr = NF_GET_VAR_DOUBLE(nid_trac, nvarid_trac, trac_tmp) … … 658 671 ierr = NF_GET_VAR_REAL(nid_trac, nvarid_trac, trac_tmp) 659 672 #endif 660 IF (ierr .NE. NF_NOERR) THEN661 PRINT*, "Lecture echouee pour", tname(iq)662 CALL abort663 ENDIF664 ierr = NF_INQ_VARID(nid, tname(iq), nvarid)665 IF (ierr .NE. NF_NOERR) THEN666 PRINT*, "Variable ", tname(iq)," n est pas definie"667 CALL abort668 ENDIF669 #ifdef NC_DOUBLE 670 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,trac_tmp)671 #else 672 ierr = NF_PUT_VAR_REAL (nid,nvarid,trac_tmp)673 #endif 674 675 ENDIF673 IF (ierr .NE. NF_NOERR) THEN 674 PRINT*, "Lecture echouee pour", tname(iq) 675 CALL abort 676 ENDIF 677 ierr = NF_INQ_VARID(nid, tname(iq), nvarid) 678 IF (ierr .NE. NF_NOERR) THEN 679 PRINT*, "Variable ", tname(iq)," n est pas definie" 680 CALL abort 681 ENDIF 682 #ifdef NC_DOUBLE 683 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,trac_tmp) 684 #else 685 ierr = NF_PUT_VAR_REAL (nid,nvarid,trac_tmp) 686 #endif 687 688 ENDIF ! IF (ierr .NE. NF_NOERR) 676 689 ! fin lecture du traceur 677 ELSE ! si il n'y a pas de fichier start_trac.nc690 ELSE ! si il n'y a pas de fichier start_trac.nc 678 691 ! print *, 'il n y a pas de fichier start_trac' 679 692 ierr = NF_INQ_VARID(nid, tname(iq), nvarid) … … 687 700 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) 688 701 #endif 689 ENDIF 690 ! endif ifdef INCA 691 #endif 692 693 #ifndef INCA 694 ierr = NF_INQ_VARID(nid, tname(iq), nvarid) 695 IF (ierr .NE. NF_NOERR) THEN 696 PRINT*, "Variable tname(iq) n est pas definie" 697 CALL abort 698 ENDIF 699 #ifdef NC_DOUBLE 700 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,q(1,1,iq)) 701 #else 702 ierr = NF_PUT_VAR_REAL (nid,nvarid,q(1,1,iq)) 703 #endif 704 ! endif ifndef INCA 705 #endif 702 ENDIF ! (ierr_file .ne. 2) 703 END IF ! config_inca 704 706 705 ENDDO 707 706 ENDIF -
LMDZ4/trunk/libf/dyn3d/gcm.F
r956 r960 220 220 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 221 221 222 IF (config_inca /= 'none') THEN 222 223 #ifdef INCA 223 224 call init_const_lmdz(nbtrac,anneeref,dayref,iphysiq,day_step,nday) 224 225 call init_inca_para(iim,jjm+1,klon,1,klon_mpi_para_nb,0) 225 226 #endif 226 227 END IF 227 228 c 228 229 c … … 259 260 endif 260 261 262 IF (config_inca /= 'none') THEN 261 263 #ifdef INCA 262 call init_inca_dim(klon,llm,iim,jjm, 263 $ rlonu,rlatu,rlonv,rlatv) 264 #endif 264 call init_inca_dim(klon,llm,iim,jjm, 265 $ rlonu,rlatu,rlonv,rlatv) 266 #endif 267 END IF 265 268 266 269 -
LMDZ4/trunk/libf/dyn3d/iniadvtrac.F
r762 r960 27 27 #include "dimensions.h" 28 28 #include "advtrac.h" 29 29 #include "control.h" 30 30 c local 31 31 character*3 descrq(30) … … 55 55 descrq(30)='PRA' 56 56 57 IF (config_inca /= 'none') THEN 57 58 #ifdef INCA 58 59 CALL init_transport( 60 $ hadv_flg, 61 $ vadv_flg, 62 $ conv_flg, 63 $ pbl_flg, 64 $ tracnam) 59 CALL init_transport( 60 $ hadv_flg, 61 $ vadv_flg, 62 $ conv_flg, 63 $ pbl_flg, 64 $ tracnam) 65 65 #endif 66 END IF 66 67 67 68 c----------------------------------------------------------------------- … … 109 110 c dans fichier traceur.def 110 111 c------------------------------------------------------------------ 111 #ifdef INCA 112 IF (config_inca == 'none') THEN 113 print*,'ouverture de traceur.def' 114 open(90,file='traceur.def',form='formatted',status='old', 115 s iostat=ierr) 116 if(ierr.eq.0) then 117 print*,'ouverture de traceur.def ok' 118 read(90,*) nq 119 print*,'nombre de traceurs ',nq 120 if (nq.gt.nqmx) then 121 print*,'nombre de traceurs trop important' 122 print*,'verifier traceur.def' 123 stop 124 endif 125 C 126 do iq=1,nq 127 read(90,999) hadv(iq),vadv(iq),tnom(iq) 128 end do 129 close(90) 130 PRINT*,'lecture de traceur.def :' 131 do iq=1,nq 132 write(*,*) hadv(iq),vadv(iq),tnom(iq) 133 end do 134 else 135 print*,'pb ouverture traceur.def' 136 print*,'ATTENTION on prend des valeurs par defaut' 137 nq = 4 138 hadv(1) = 14 139 vadv(1) = 14 140 tnom(1) = 'H2Ov' 141 hadv(2) = 10 142 vadv(2) = 10 143 tnom(2) = 'H2Ol' 144 hadv(3) = 10 145 vadv(3) = 10 146 tnom(3) = 'RN' 147 hadv(4) = 10 148 vadv(4) = 10 149 tnom(4) = 'PB' 150 ENDIF 151 PRINT*,'Valeur de traceur.def :' 152 do iq=1,nq 153 write(*,*) hadv(iq),vadv(iq),tnom(iq) 154 end do 155 ELSE ! config_inca='aero' ou 'chem' 112 156 C le module de chimie fournit les noms des traceurs 113 157 C et les schemas d'advection associes. 114 tnom(1)='H2Ov' 115 tnom(2)='H2Ol' 116 nq=nbtrac+2 117 if (nq.gt.nqmx) then 118 print*,'nombre de traceurs incompatible INCA/LMDZT' 119 stop 120 endif 121 do iq =3,nq 122 tnom(iq)=tracnam(iq-2) 123 end do 124 do iq =1,nq 125 hadv(iq)= hadv_flg(iq) 126 vadv(iq)= vadv_flg(iq) 127 end do 128 #else 129 print*,'ouverture de traceur.def' 130 open(90,file='traceur.def',form='formatted',status='old', 131 s iostat=ierr) 132 if(ierr.eq.0) then 133 print*,'ouverture de traceur.def ok' 134 read(90,*) nq 135 print*,'nombre de traceurs ',nq 136 if (nq.gt.nqmx) then 137 print*,'nombre de traceurs trop important' 138 print*,'verifier traceur.def' 139 stop 140 endif 141 C 142 do iq=1,nq 143 read(90,999) hadv(iq),vadv(iq),tnom(iq) 144 end do 145 close(90) 146 PRINT*,'lecture de traceur.def :' 147 do iq=1,nq 148 write(*,*) hadv(iq),vadv(iq),tnom(iq) 149 end do 150 else 151 print*,'pb ouverture traceur.def' 152 print*,'ATTENTION on prend des valeurs par defaut' 153 nq = 4 154 hadv(1) = 14 155 vadv(1) = 14 156 tnom(1) = 'H2Ov' 157 hadv(2) = 10 158 vadv(2) = 10 159 tnom(2) = 'H2Ol' 160 hadv(3) = 10 161 vadv(3) = 10 162 tnom(3) = 'RN' 163 hadv(4) = 10 164 vadv(4) = 10 165 tnom(4) = 'PB' 166 ENDIF 167 PRINT*,'Valeur de traceur.def :' 168 do iq=1,nq 169 write(*,*) hadv(iq),vadv(iq),tnom(iq) 170 end do 171 172 #endif 158 tnom(1)='H2Ov' 159 tnom(2)='H2Ol' 160 nq=nbtrac+2 161 if (nq.gt.nqmx) then 162 print*,'nombre de traceurs incompatible INCA/LMDZT' 163 stop 164 endif 165 do iq =3,nq 166 tnom(iq)=tracnam(iq-2) 167 end do 168 do iq =1,nq 169 hadv(iq)= hadv_flg(iq) 170 vadv(iq)= vadv_flg(iq) 171 end do 172 END IF ! config_inca 173 173 174 c a partir du nom court du traceur et du schema d'advection au detemine le nom long. 174 175 iiq=0 -
LMDZ4/trunk/libf/dyn3d/leapfrog.F
r956 r960 149 149 150 150 REAL alpha(ip1jmp1,llm),beta(ip1jmp1,llm) 151 #ifdef INCA 152 REAL :: flxw(ip1jmp1,llm) 153 #endif 151 REAL :: flxw(ip1jmp1,llm) ! flux de masse verticale 154 152 155 153 c+jld variables test conservation energie … … 293 291 IF( forward. OR . leapf ) THEN 294 292 295 c 296 #ifdef INCA 297 CALL caladvtrac(q,pbaru,pbarv, 298 * p, masse, dq, teta, 299 . flxw, 300 . pk) 301 #else 302 CALL caladvtrac(q,pbaru,pbarv, 303 * p, masse, dq, teta, 304 . pk) 305 #endif 306 293 CALL caladvtrac(q,pbaru,pbarv, 294 * p, masse, dq, teta, 295 . flxw, pk) 296 307 297 IF (offline) THEN 308 298 Cmaf stokage du flux de masse pour traceurs OFF-LINE … … 383 373 CALL calfis( nq, lafin ,rdayvrai,time , 384 374 $ ucov,vcov,teta,q,masse,ps,p,pk,phis,phi , 385 $ du,dv,dteta,dq,w, 386 #ifdef INCA 375 $ du,dv,dteta,dq, 387 376 $ flxw, 388 #endif389 377 $ clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi ) 390 378 -
LMDZ4/trunk/libf/dyn3dpar/advtrac_p.F
r764 r960 4 4 c 5 5 c 6 #ifdef INCA7 6 SUBROUTINE advtrac_p(pbaru,pbarv , 8 7 * p, masse,q,iapptrac,teta, 9 8 * flxw, 10 9 * pk ) 11 #else12 SUBROUTINE advtrac_p(pbaru,pbarv ,13 * p, masse,q,iapptrac,teta,14 * pk)15 #endif16 10 17 11 c Auteur : F. Hourdin … … 55 49 REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm) 56 50 REAL pk(ip1jmp1,llm) 57 #ifdef INCA 58 REAL :: flxw(ip1jmp1,llm) 59 #endif 51 REAL :: flxw(ip1jmp1,llm) 60 52 61 53 c------------------------------------------------------------- … … 209 201 c$OMP BARRIER 210 202 211 #ifdef INCA212 203 ! ... Flux de masse diaganostiques traceurs 213 c flxw = wg / FLOAT(iapp_tracvl)214 204 ijb=ij_begin 215 205 ije=ij_end 216 206 flxw(ijb:ije,1:llm)=wg(ijb:ije,1:llm)/FLOAT(iapp_tracvl) 217 #endif218 207 219 208 c test sur l'eventuelle creation de valeurs negatives de la masse … … 327 316 328 317 call pentes_ini (q(1,1,iq),wg,massem,pbarug,pbarvg,0) 329 #ifdef INCA330 do iiq = iq+1, iq+3331 q(:,:,iiq)=q(:,:,iiq)*1332 enddo333 #endif334 318 335 319 c ---------------------------------------------------------------- … … 346 330 call prather(q(1,1,iq),wg,massem,pbarug,pbarvg, 347 331 s n,dtbon) 348 #ifdef INCA349 do iiq = iq+1, iq+9350 q(:,:,iiq)=q(:,:,iiq)*1351 enddo352 #endif353 332 c ---------------------------------------------------------------- 354 333 c Schemas PPM Lin et Rood … … 487 466 enddo 488 467 489 #ifdef INCA 490 call Register_SwapFieldHallo(flxw,flxw,ip1jmp1,llm, 491 * jj_nb_caldyn,0,0,Request_vanleer) 492 #endif 468 call Register_SwapFieldHallo(flxw,flxw,ip1jmp1,llm, 469 * jj_nb_caldyn,0,0,Request_vanleer) 470 493 471 call SetDistrib(jj_nb_caldyn) 494 472 call SendRequest(Request_vanleer) -
LMDZ4/trunk/libf/dyn3dpar/caladvtrac_p.F
r764 r960 4 4 c 5 5 c 6 #ifdef INCA7 6 SUBROUTINE caladvtrac_p(q,pbaru,pbarv , 8 7 * p ,masse, dq , teta, 9 * flxw, 10 * pk, 11 * iapptrac) 12 #else 13 SUBROUTINE caladvtrac_p(q,pbaru,pbarv , 14 * p ,masse, dq , teta, 15 * pk,iapptrac) 16 #endif 8 * flxw, pk, iapptrac) 17 9 USE parallel 18 10 c … … 40 32 REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqmx),dq( ip1jmp1,llm,2 ) 41 33 REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm) 42 #ifdef INCA43 34 REAL :: flxw(ip1jmp1,llm) 44 #endif 35 45 36 integer ijb,ije,jjb,jje 46 37 … … 74 65 c print *,'appel a advtrac' 75 66 76 #ifdef INCA77 67 CALL advtrac_p( pbaru,pbarv, 78 68 * p, masse,q,iapptrac, teta, 79 . flxw, 80 . pk) 81 #else 82 CALL advtrac_p( pbaru,pbarv, 83 * p, masse,q,iapptrac, teta, 84 . pk) 85 #endif 86 c 69 . flxw, pk) 87 70 88 71 goto 9999 -
LMDZ4/trunk/libf/dyn3dpar/calfis_p.F
r774 r960 22 22 $ pdteta, 23 23 $ pdq, 24 $ pw,25 #ifdef INCA26 24 $ flxw, 27 #endif28 25 $ clesphy0, 29 26 $ pdufi, … … 130 127 REAL pdq(iip1,jjp1,llm,nqmx) 131 128 c 132 REAL pw(iip1,jjp1,llm)133 134 129 REAL pps(iip1,jjp1) 135 130 REAL pp(iip1,jjp1,llmp1) … … 161 156 REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:) 162 157 c 163 REAL,ALLOCATABLE,SAVE :: pvervel(:,:)158 c REAL,ALLOCATABLE,SAVE :: pvervel(:,:) 164 159 c 165 160 REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:) … … 176 171 REAL,ALLOCATABLE,SAVE :: ztfi_omp(:,:) 177 172 REAL,ALLOCATABLE,SAVE :: zqfi_omp(:,:,:) 178 REAL,ALLOCATABLE,SAVE :: pvervel_omp(:,:)173 c REAL,ALLOCATABLE,SAVE :: pvervel_omp(:,:) 179 174 REAL,ALLOCATABLE,SAVE :: zdufi_omp(:,:) 180 175 REAL,ALLOCATABLE,SAVE :: zdvfi_omp(:,:) … … 202 197 REAL PVteta(klon,ntetaSTD) 203 198 204 #ifdef INCA 205 REAL flxw(iip1,jjp1,llm) 206 REAL flxwfi(klon,llm) 207 #endif 208 c 199 REAL flxw(iip1,jjp1,llm) ! Flux de masse verticale sur la grille dynamique 200 REAL flxwfi(klon,llm) ! Flux de masse verticale sur la grille physiq 209 201 210 202 REAL SSUM … … 257 249 ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm)) 258 250 ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2)) 259 ALLOCATE(pvervel(klon,llm))251 c ALLOCATE(pvervel(klon,llm)) 260 252 ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm)) 261 253 ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqmx)) … … 380 372 ENDDO 381 373 ENDDO 382 c$OMP END DO NOWAIT 374 c$OMP END DO NOWAIT 375 383 376 c .... Calcul de la vitesse verticale ( en Pa*m*s ou Kg/s ) .... 384 c 385 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 386 DO l=1,llm 387 do ig0=1,klon 388 i=index_i(ig0) 389 j=index_j(ig0) 390 pvervel(ig0,l) = pw(i,j,l)*g* unsaire(i,j) 391 enddo 392 if (is_north_pole) pvervel(1,l)=pw(1,1,l)*g /apoln 393 if (is_south_pole) pvervel(klon,l)=pw(1,jjp1,l)*g/apols 394 ENDDO 395 c$OMP END DO NOWAIT 377 c JG : ancien calcule de omega utilise dans physiq.F. Maintenant le flux 378 c de masse est calclue dans advtrac_p.F 379 c 380 cc$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 381 c DO l=1,llm 382 c do ig0=1,klon 383 c i=index_i(ig0) 384 c j=index_j(ig0) 385 c pvervel(ig0,l) = pw(i,j,l)*g* unsaire(i,j) 386 c enddo 387 c if (is_north_pole) pvervel(1,l)=pw(1,1,l)*g /apoln 388 c if (is_south_pole) pvervel(klon,l)=pw(1,jjp1,l)*g/apols 389 c ENDDO 390 cc$OMP END DO NOWAIT 396 391 397 392 c … … 514 509 c 515 510 ENDIF 516 #ifdef INCA 511 512 c On change de grille, dynamique vers physiq, pour le flux de masse verticale 517 513 CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,flxw,flxwfi) 518 #endif519 520 514 521 515 c----------------------------------------------------------------------- … … 548 542 allocate(ztfi_omp(klon,llm)) 549 543 allocate(zqfi_omp(klon,llm,nq)) 550 allocate(pvervel_omp(klon,llm))544 c allocate(pvervel_omp(klon,llm)) 551 545 allocate(zdufi_omp(klon,llm)) 552 546 allocate(zdvfi_omp(klon,llm)) … … 614 608 enddo 615 609 616 do l=1,llm617 do i=1,klon618 pvervel_omp(i,l)=pvervel(offset+i,l)619 enddo620 enddo610 c do l=1,llm 611 c do i=1,klon 612 c pvervel_omp(i,l)=pvervel(offset+i,l) 613 c enddo 614 c enddo 621 615 622 616 do l=1,llm … … 671 665 . ztfi_omp, 672 666 . zqfi_omp, 673 . pvervel_omp,674 #ifdef INCA667 c . pvervel_omp, 668 c#ifdef INCA 675 669 . flxwfi, 676 #endif670 c#endif 677 671 . zdufi_omp, 678 672 . zdvfi_omp, … … 742 736 enddo 743 737 744 do l=1,llm745 do i=1,klon746 pvervel(offset+i,l)=pvervel_omp(i,l)747 enddo748 enddo738 c do l=1,llm 739 c do i=1,klon 740 c pvervel(offset+i,l)=pvervel_omp(i,l) 741 c enddo 742 c enddo 749 743 750 744 do l=1,llm -
LMDZ4/trunk/libf/dyn3dpar/conf_gcm.F
r764 r960 600 600 offline = .FALSE. 601 601 CALL getin('offline',offline) 602 603 !Config Key = config_inca 604 !Config Desc = Choix de configuration de INCA 605 !Config Def = none 606 !Config Help = Choix de configuration de INCA : 607 !Config 'none' = sans INCA 608 !Config 'chem' = INCA avec calcul de chemie 609 !Config 'aero' = INCA avec calcul des aerosols 610 config_inca = 'none' 611 CALL getin('config_inca',config_inca) 602 612 603 613 … … 643 653 write(lunout,*)' tauyy = ', tauyy 644 654 write(lunout,*)' offline = ', offline 655 write(lunout,*)' config_inca = ', config_inca 645 656 646 657 RETURN … … 755 766 offline = .FALSE. 756 767 CALL getin('offline',offline) 757 write(lunout,*)' offline = ', offline 768 769 !Config Key = config_inca 770 !Config Desc = Choix de configuration de INCA 771 !Config Def = none 772 !Config Help = Choix de configuration de INCA : 773 !Config 'none' = sans INCA 774 !Config 'chem' = INCA avec calcul de chemie 775 !Config 'aero' = INCA avec calcul des aerosols 776 config_inca = 'none' 777 CALL getin('config_inca',config_inca) 758 778 759 779 … … 799 819 write(lunout,*)' tauy = ', tauy 800 820 write(lunout,*)' offline = ', offline 821 write(lunout,*)' config_inca = ', config_inca 801 822 c 802 823 RETURN -
LMDZ4/trunk/libf/dyn3dpar/control.h
r792 r960 14 14 & iperiod,iapp_tracvl,iconser,iecri,idissip,iphysiq , & 15 15 & periodav,ecritphy,iecrimoy,dayref,anneeref, & 16 & raz_date,offline,ip_ebil_dyn 16 & raz_date,offline,ip_ebil_dyn,config_inca 17 17 18 18 INTEGER nday,day_step,iperiod,iapp_tracvl,iconser,iecri, & … … 21 21 REAL periodav, ecritphy 22 22 logical offline 23 23 CHARACTER*4 config_inca 24 24 !----------------------------------------------------------------------- -
LMDZ4/trunk/libf/dyn3dpar/gcm.F
r949 r960 230 230 call InitComgeomphy 231 231 c$OMP END PARALLEL 232 233 IF (config_inca /= 'none') THEN 232 234 #ifdef INCA 233 call init_const_lmdz(nbtrac,anneeref,dayref,iphysiq,day_step,nday) 234 call init_inca_para(iim,jjm+1,klon_glo,mpi_size,klon_mpi_para_nb, 235 $ COMM_LMDZ) 236 #endif 235 call init_const_lmdz(nbtrac,anneeref,dayref,iphysiq,day_step,nday) 236 call init_inca_para(iim,jjm+1,klon_glo,mpi_size,klon_mpi_para_nb, 237 $ COMM_LMDZ) 238 #endif 239 END IF 237 240 238 241 c----------------------------------------------------------------------- … … 262 265 endif 263 266 267 IF (config_inca /= 'none') THEN 264 268 #ifdef INCA 265 call init_inca_dim(klon,llm,iim,jjm,266 $ rlonu,rlatu,rlonv,rlatv)267 #endif 268 269 call init_inca_dim(klon,llm,iim,jjm, 270 $ rlonu,rlatu,rlonv,rlatv) 271 #endif 272 END IF 269 273 270 274 c le cas echeant, creation d un etat initial -
LMDZ4/trunk/libf/dyn3dpar/iniadvtrac.F
r764 r960 27 27 #include "dimensions.h" 28 28 #include "advtrac.h" 29 #include "control.h" 29 30 30 31 c local … … 55 56 descrq(30)='PRA' 56 57 58 IF (config_inca /= 'none') THEN 57 59 #ifdef INCA 58 59 CALL init_transport( 60 $ hadv_flg, 61 $ vadv_flg, 62 $ conv_flg, 63 $ pbl_flg, 64 $ tracnam) 60 CALL init_transport( 61 $ hadv_flg, 62 $ vadv_flg, 63 $ conv_flg, 64 $ pbl_flg, 65 $ tracnam) 65 66 #endif 66 67 END IF 67 68 c----------------------------------------------------------------------- 68 69 c Choix des schemas d'advection pour l'eau et les traceurs … … 109 110 c dans fichier traceur.def 110 111 c------------------------------------------------------------------ 111 #ifdef INCA 112 113 IF (config_inca /= 'none') THEN 112 114 C le module de chimie fournit les noms des traceurs 113 115 C et les schemas d'advection associes. 114 tnom(1)='H2Ov'115 tnom(2)='H2Ol'116 nq=nbtrac+2116 tnom(1)='H2Ov' 117 tnom(2)='H2Ol' 118 nq=nbtrac+2 117 119 118 120 if (nq.gt.nqmx) then … … 127 129 vadv(iq)= vadv_flg(iq) 128 130 end do 129 #else130 print*,'ouverture de traceur.def'131 open(90,file='traceur.def',form='formatted',status='old',132 s iostat=ierr)131 ELSE ! config_inca=none 132 print*,'ouverture de traceur.def' 133 open(90,file='traceur.def',form='formatted',status='old', 134 s iostat=ierr) 133 135 if(ierr.eq.0) then 134 136 print*,'ouverture de traceur.def ok' … … 171 173 end do 172 174 173 #endif 175 END IF ! config_inca 176 174 177 c a partir du nom court du traceur et du schema d'advection au detemine le nom long. 175 178 iiq=0 -
LMDZ4/trunk/libf/dyn3dpar/leapfrog_p.F
r949 r960 146 146 147 147 REAL,SAVE :: alpha(ip1jmp1,llm),beta(ip1jmp1,llm) 148 #ifdef INCA 149 REAL,SAVE :: flxw(ip1jmp1,llm) 150 #endif 148 REAL,SAVE :: flxw(ip1jmp1,llm) ! flux de masse verticale 151 149 152 150 c+jld variables test conservation energie … … 565 563 cc$OMP PARALLEL DEFAULT(SHARED) 566 564 c 567 #ifdef INCA 568 CALL caladvtrac_p(q,pbaru,pbarv, 569 * p, masse, dq, teta, 570 . flxw, 571 . pk, 572 . iapptrac) 573 #else 574 CALL caladvtrac_p(q,pbaru,pbarv, 575 * p, masse, dq, teta, 576 . pk,iapptrac) 577 #endif 578 579 580 565 CALL caladvtrac_p(q,pbaru,pbarv, 566 * p, masse, dq, teta, 567 . flxw,pk, iapptrac) 568 581 569 c do j=1,nqmx 582 570 c call WriteField_p('q'//trim(int2str(j)), … … 722 710 * jj_Nb_physic,2,2,Request_physic) 723 711 enddo 724 #ifdef INCA 712 725 713 call Register_SwapFieldHallo(flxw,flxw,ip1jmp1,llm, 726 714 * jj_Nb_physic,2,2,Request_physic) 727 #endif728 715 call SetDistrib(jj_nb_Physic) 729 716 … … 748 735 CALL calfis_p( nq, lafin ,rdayvrai,time , 749 736 $ ucov,vcov,teta,q,masse,ps,p,pk,phis,phi , 750 $ du,dv,dteta,dq,w, 751 #ifdef INCA 737 $ du,dv,dteta,dq, 752 738 $ flxw, 753 #endif754 739 $ clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi ) 755 740 ijb=ij_begin
Note: See TracChangeset
for help on using the changeset viewer.