Changeset 1403 for LMDZ4/trunk/libf/dyn3dpar
- Timestamp:
- Jul 1, 2010, 11:02:53 AM (14 years ago)
- Location:
- LMDZ4/trunk
- Files:
-
- 4 deleted
- 44 edited
- 4 copied
-
. (modified) (1 prop)
-
libf/dyn3dpar/adaptdt.F (modified) (2 diffs)
-
libf/dyn3dpar/advtrac_p.F (modified) (4 diffs)
-
libf/dyn3dpar/bilan_dyn_p.F (modified) (1 diff)
-
libf/dyn3dpar/caladvtrac_p.F (modified) (3 diffs)
-
libf/dyn3dpar/calfis_p.F (modified) (13 diffs)
-
libf/dyn3dpar/ce0l.F90 (modified) (2 diffs)
-
libf/dyn3dpar/com_io_dyn.h (deleted)
-
libf/dyn3dpar/com_io_dyn_mod.F90 (copied) (copied from LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/com_io_dyn_mod.F90)
-
libf/dyn3dpar/conf_gcm.F (modified) (8 diffs)
-
libf/dyn3dpar/control.h (deleted)
-
libf/dyn3dpar/control_mod.F90 (copied) (copied from LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/control_mod.F90)
-
libf/dyn3dpar/covnat.F (copied) (copied from LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/covnat.F)
-
libf/dyn3dpar/defrun.F (modified) (4 diffs)
-
libf/dyn3dpar/disvert.F (modified) (2 diffs)
-
libf/dyn3dpar/dynetat0.F (modified) (34 diffs)
-
libf/dyn3dpar/dynredem.F (modified) (23 diffs)
-
libf/dyn3dpar/dynredem_p.F (modified) (5 diffs)
-
libf/dyn3dpar/etat0_netcdf.F90 (modified) (4 diffs)
-
libf/dyn3dpar/exner_hyb.F (modified) (2 diffs)
-
libf/dyn3dpar/exner_hyb_p.F (modified) (2 diffs)
-
libf/dyn3dpar/extrapol.F (modified) (2 diffs)
-
libf/dyn3dpar/fluxstokenc_p.F (modified) (5 diffs)
-
libf/dyn3dpar/friction_p.F (modified) (2 diffs)
-
libf/dyn3dpar/fxhyp.F (modified) (4 diffs)
-
libf/dyn3dpar/fxy.F (modified) (4 diffs)
-
libf/dyn3dpar/fxysinus.F (modified) (4 diffs)
-
libf/dyn3dpar/fyhyp.F (modified) (4 diffs)
-
libf/dyn3dpar/gcm.F (modified) (9 diffs)
-
libf/dyn3dpar/grid_atob.F (modified) (2 diffs)
-
libf/dyn3dpar/grid_noro.F (modified) (4 diffs)
-
libf/dyn3dpar/grilles_gcm_netcdf.F (modified) (2 diffs)
-
libf/dyn3dpar/guide_p_mod.F90 (modified) (8 diffs)
-
libf/dyn3dpar/infotrac.F90 (modified) (2 diffs)
-
libf/dyn3dpar/iniacademic.F (modified) (9 diffs)
-
libf/dyn3dpar/iniconst.F (modified) (3 diffs)
-
libf/dyn3dpar/inidissip.F (modified) (3 diffs)
-
libf/dyn3dpar/inigeom.F (modified) (4 diffs)
-
libf/dyn3dpar/integrd_p.F (modified) (2 diffs)
-
libf/dyn3dpar/interpre.F (modified) (3 diffs)
-
libf/dyn3dpar/leapfrog_p.F (modified) (22 diffs)
-
libf/dyn3dpar/limit_netcdf.F90 (modified) (3 diffs)
-
libf/dyn3dpar/ord_coord.F (deleted)
-
libf/dyn3dpar/ord_coordm.F (deleted)
-
libf/dyn3dpar/ppm3d.F (modified) (13 diffs)
-
libf/dyn3dpar/ran1.F (modified) (3 diffs)
-
libf/dyn3dpar/sortvarc.F (modified) (3 diffs)
-
libf/dyn3dpar/sortvarc0.F (modified) (3 diffs)
-
libf/dyn3dpar/sw_case_williamson91_6.F (copied) (copied from LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/sw_case_williamson91_6.F)
-
libf/dyn3dpar/tourabs.F (modified) (1 diff)
-
libf/dyn3dpar/traceurpole.F (modified) (2 diffs)
-
libf/dyn3dpar/ugeostr.F (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk
- Property svn:mergeinfo changed
-
LMDZ4/trunk/libf/dyn3dpar/adaptdt.F
r774 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 subroutine adaptdt(nadv,dtbon,n,pbaru, 5 5 c masse) 6 7 USE control_mod 6 8 7 9 IMPLICIT NONE … … 16 18 #include "logic.h" 17 19 #include "temps.h" 18 #include "control.h"19 20 #include "ener.h" 20 21 #include "description.h" -
LMDZ4/trunk/libf/dyn3dpar/advtrac_p.F
r1146 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 23 23 USE times 24 24 USE infotrac 25 USE control_mod 25 26 IMPLICIT NONE 26 27 c … … 33 34 #include "logic.h" 34 35 #include "temps.h" 35 #include "control.h"36 36 #include "ener.h" 37 37 #include "description.h" … … 215 215 ijb=ij_begin 216 216 ije=ij_end 217 flxw(ijb:ije,1:llm)=wg(ijb:ije,1:llm)/ FLOAT(iapp_tracvl)217 flxw(ijb:ije,1:llm)=wg(ijb:ije,1:llm)/REAL(iapp_tracvl) 218 218 219 219 c test sur l'eventuelle creation de valeurs negatives de la masse -
LMDZ4/trunk/libf/dyn3dpar/bilan_dyn_p.F
r1279 r1403 511 511 . /masse_cum(:,jjb:jje,:) 512 512 enddo 513 zz=1./ float(ncum)513 zz=1./REAL(ncum) 514 514 515 515 jjb=jj_begin -
LMDZ4/trunk/libf/dyn3dpar/caladvtrac_p.F
r1279 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 9 9 USE parallel 10 10 USE infotrac 11 USE control_mod 11 12 c 12 13 IMPLICIT NONE … … 25 26 #include "paramet.h" 26 27 #include "comconst.h" 27 #include "control.h"28 28 29 29 c Arguments: -
LMDZ4/trunk/libf/dyn3dpar/calfis_p.F
r1279 r1403 34 34 USE dimphy 35 35 USE mod_phys_lmdz_para, mpi_root_xx=>mpi_root 36 USE mod_interface_dyn_phys 37 USE IOPHY 38 #endif 36 39 USE parallel, ONLY : omp_chunk, using_mpi 37 USE mod_interface_dyn_phys38 40 USE Write_Field 39 41 Use Write_field_p 40 42 USE Times 41 USE IOPHY42 43 USE infotrac 44 USE control_mod 43 45 44 46 IMPLICIT NONE … … 107 109 #include "comvert.h" 108 110 #include "comgeom2.h" 109 #include " control.h"111 #include "iniprint.h" 110 112 #ifdef CPP_MPI 111 113 include 'mpif.h' … … 114 116 c ----------- 115 117 LOGICAL lafin 116 REAL heure117 118 ! REAL heure 119 REAL, intent(in):: jD_cur, jH_cur 118 120 REAL pvcov(iip1,jjm,llm) 119 121 REAL pucov(iip1,jjp1,llm) … … 128 130 REAL pdteta(iip1,jjp1,llm) 129 131 REAL pdq(iip1,jjp1,llm,nqtot) 132 REAL flxw(iip1,jjp1,llm) ! Flux de masse verticale sur la grille dynamique 130 133 c 131 134 REAL pps(iip1,jjp1) … … 143 146 REAL clesphy0( longcles ) 144 147 145 148 #ifdef CPP_EARTH 146 149 c Local variables : 147 150 c ----------------- … … 180 183 REAL,SAVE,ALLOCATABLE :: flxwfi_omp(:,:) ! Flux de masse verticale sur la grille physiq 181 184 185 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 186 ! Introduction du splitting (FH) 187 ! Question pour Yann : 188 ! J'ai été surpris au début que les tableaux zufi_omp, zdufi_omp n'co soitent 189 ! en SAVE. Je crois comprendre que c'est parce que tu voulais qu'il 190 ! soit allocatable (plutot par exemple que de passer une dimension 191 ! dépendant du process en argument des routines) et que, du coup, 192 ! le SAVE évite d'avoir à refaire l'allocation à chaque appel. 193 ! Tu confirmes ? 194 ! J'ai suivi le même principe pour les zdufic_omp 195 ! Mais c'est surement bien que tu controles. 196 ! 197 198 REAL,ALLOCATABLE,SAVE :: zdufic_omp(:,:) 199 REAL,ALLOCATABLE,SAVE :: zdvfic_omp(:,:) 200 REAL,ALLOCATABLE,SAVE :: zdtfic_omp(:,:) 201 REAL,ALLOCATABLE,SAVE :: zdqfic_omp(:,:,:) 202 REAL jH_cur_split,zdt_split 203 LOGICAL debut_split,lafin_split 204 INTEGER isplit 205 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 206 182 207 c$OMP THREADPRIVATE(zplev_omp,zplay_omp,zphi_omp,zphis_omp, 183 208 c$OMP+ presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp, 184 209 c$OMP+ zqfi_omp,zdufi_omp,zdvfi_omp, 185 c$OMP+ zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp) 210 c$OMP+ zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp, 211 c$OMP+ zdufic_omp,zdvfic_omp,zdtfic_omp,zdqfic_omp) 186 212 187 213 LOGICAL,SAVE :: first_omp=.true. … … 199 225 REAL PVteta(klon,ntetaSTD) 200 226 201 REAL flxw(iip1,jjp1,llm) ! Flux de masse verticale sur la grille dynamique202 227 203 228 REAL SSUM … … 207 232 SAVE firstcal,debut 208 233 c$OMP THREADPRIVATE(firstcal,debut) 209 REAL, intent(in):: jD_cur, jH_cur210 234 211 235 REAL,SAVE,dimension(1:iim,1:llm):: du_send,du_recv,dv_send,dv_recv … … 235 259 debut = .TRUE. 236 260 IF (ngridmx.NE.2+(jjm-1)*iim) THEN 237 PRINT*,'STOP dans calfis' 238 PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim' 239 PRINT*,' ngridmx jjm iim ' 240 PRINT*,ngridmx,jjm,iim 261 write(lunout,*) 'STOP dans calfis' 262 write(lunout,*) 263 & 'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim' 264 write(lunout,*) ' ngridmx jjm iim ' 265 write(lunout,*) ngridmx,jjm,iim 241 266 STOP 242 267 ENDIF … … 498 523 allocate(zdtfi_omp(klon,llm)) 499 524 allocate(zdqfi_omp(klon,llm,nqtot)) 525 allocate(zdufic_omp(klon,llm)) 526 allocate(zdvfic_omp(klon,llm)) 527 allocate(zdtfic_omp(klon,llm)) 528 allocate(zdqfic_omp(klon,llm,nqtot)) 500 529 allocate(zdpsrf_omp(klon)) 501 530 allocate(flxwfi_omp(klon,llm)) … … 600 629 if (planet_type=="earth") then 601 630 #ifdef CPP_EARTH 631 632 !$OMP MASTER 633 write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys 634 !$OMP END MASTER 635 zdt_split=dtphys/nsplit_phys 636 zdufic_omp(:,:)=0. 637 zdvfic_omp(:,:)=0. 638 zdtfic_omp(:,:)=0. 639 zdqfic_omp(:,:,:)=0. 640 641 do isplit=1,nsplit_phys 642 643 jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys) 644 debut_split=debut.and.isplit==1 645 lafin_split=lafin.and.isplit==nsplit_phys 646 647 602 648 CALL physiq (klon, 603 649 . llm, 604 . debut ,605 . lafin ,650 . debut_split, 651 . lafin_split, 606 652 . jD_cur, 607 . jH_cur ,608 . dtphys,653 . jH_cur_split, 654 . zdt_split, 609 655 . zplev_omp, 610 656 . zplay_omp, … … 628 674 . pducov, 629 675 . PVteta) 676 677 zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split 678 zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split 679 ztfi_omp(:,:)=ztfi_omp(:,:)+zdtfi_omp(:,:)*zdt_split 680 zqfi_omp(:,:,:)=zqfi_omp(:,:,:)+zdqfi_omp(:,:,:)*zdt_split 681 682 zdufic_omp(:,:)=zdufic_omp(:,:)+zdufi_omp(:,:) 683 zdvfic_omp(:,:)=zdvfic_omp(:,:)+zdvfi_omp(:,:) 684 zdtfic_omp(:,:)=zdtfic_omp(:,:)+zdtfi_omp(:,:) 685 zdqfic_omp(:,:,:)=zdqfic_omp(:,:,:)+zdqfi_omp(:,:,:) 686 687 enddo 688 689 zdufi_omp(:,:)=zdufic_omp(:,:)/nsplit_phys 690 zdvfi_omp(:,:)=zdvfic_omp(:,:)/nsplit_phys 691 zdtfi_omp(:,:)=zdtfic_omp(:,:)/nsplit_phys 692 zdqfi_omp(:,:,:)=zdqfic_omp(:,:,:)/nsplit_phys 693 630 694 #endif 631 695 endif !of if (planet_type=="earth") … … 1047 1111 1048 1112 #else 1049 write(*,*) "calfis_p: for now can only work with parallel physics" 1113 write(lunout,*) 1114 & "calfis_p: for now can only work with parallel physics" 1050 1115 stop 1051 1116 #endif -
LMDZ4/trunk/libf/dyn3dpar/ce0l.F90
r1319 r1403 15 15 ! masque is created in etat0, passed to limit to ensure consistancy. 16 16 !------------------------------------------------------------------------------- 17 USE control_mod 17 18 #ifdef CPP_EARTH 18 19 ! This prog. is designed to work for Earth … … 39 40 #include "indicesol.h" 40 41 #include "iniprint.h" 41 #include "control.h"42 42 #include "temps.h" 43 43 #include "logic.h" -
LMDZ4/trunk/libf/dyn3dpar/conf_gcm.F
r1323 r1403 16 16 use mod_hallo, ONLY : use_mpi_alloc 17 17 use parallel, ONLY : omp_chunk 18 USE control_mod 18 19 IMPLICIT NONE 19 20 c----------------------------------------------------------------------- … … 38 39 #include "dimensions.h" 39 40 #include "paramet.h" 40 #include "control.h"41 41 #include "logic.h" 42 42 #include "serre.h" … … 173 173 CALL getin('day_step',day_step) 174 174 175 !Config Key = nsplit_phys 176 !Config Desc = nombre d'iteration de la physique 177 !Config Def = 240 178 !Config Help = nombre d'itration de la physique 179 ! 180 nsplit_phys = 1 181 CALL getin('nsplit_phys',nsplit_phys) 182 175 183 !Config Key = iperiod 176 184 !Config Desc = periode pour le pas Matsuno … … 589 597 CALL getin('ok_dynzon',ok_dynzon) 590 598 599 !Config Key = ok_dyn_ins 600 !Config Desc = sorties instantanees dans la dynamique 601 !Config Def = n 602 !Config Help = 603 !Config 604 ok_dyn_ins = .FALSE. 605 CALL getin('ok_dyn_ins',ok_dyn_ins) 606 607 !Config Key = ok_dyn_ave 608 !Config Desc = sorties moyennes dans la dynamique 609 !Config Def = n 610 !Config Help = 611 !Config 612 ok_dyn_ave = .FALSE. 613 CALL getin('ok_dyn_ave',ok_dyn_ave) 591 614 592 615 write(lunout,*)' #########################################' … … 599 622 write(lunout,*)' day_step = ', day_step 600 623 write(lunout,*)' iperiod = ', iperiod 624 write(lunout,*)' nsplit_phys = ', nsplit_phys 601 625 write(lunout,*)' iconser = ', iconser 602 626 write(lunout,*)' iecri = ', iecri … … 628 652 write(lunout,*)' config_inca = ', config_inca 629 653 write(lunout,*)' ok_dynzon = ', ok_dynzon 654 write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins 655 write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave 630 656 631 657 RETURN … … 760 786 ok_dynzon = .FALSE. 761 787 CALL getin('ok_dynzon',ok_dynzon) 788 789 !Config Key = ok_dyn_ins 790 !Config Desc = sorties instantanees dans la dynamique 791 !Config Def = n 792 !Config Help = 793 !Config 794 ok_dyn_ins = .FALSE. 795 CALL getin('ok_dyn_ins',ok_dyn_ins) 796 797 !Config Key = ok_dyn_ave 798 !Config Desc = sorties moyennes dans la dynamique 799 !Config Def = n 800 !Config Help = 801 !Config 802 ok_dyn_ave = .FALSE. 803 CALL getin('ok_dyn_ave',ok_dyn_ave) 762 804 763 805 !Config Key = use_filtre_fft … … 870 912 write(lunout,*)' config_inca = ', config_inca 871 913 write(lunout,*)' ok_dynzon = ', ok_dynzon 914 write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins 915 write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave 872 916 write(lunout,*)' use_filtre_fft = ', use_filtre_fft 873 917 write(lunout,*)' use_mpi_alloc = ', use_mpi_alloc -
LMDZ4/trunk/libf/dyn3dpar/defrun.F
r985 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 6 6 SUBROUTINE defrun( tapedef, etatinit, clesphy0 ) 7 7 c 8 USE control_mod 8 9 IMPLICIT NONE 9 10 c----------------------------------------------------------------------- … … 28 29 #include "dimensions.h" 29 30 #include "paramet.h" 30 #include "control.h"31 31 #include "logic.h" 32 32 #include "serre.h" … … 241 241 clesphy0(i) = 0. 242 242 ENDDO 243 clesphy0(1) = FLOAT( iflag_con )244 clesphy0(2) = FLOAT( nbapp_rad )243 clesphy0(1) = REAL( iflag_con ) 244 clesphy0(2) = REAL( nbapp_rad ) 245 245 246 246 IF( cycle_diurne ) clesphy0(3) = 1. -
LMDZ4/trunk/libf/dyn3dpar/disvert.F
r1279 r1403 111 111 snorm = 0. 112 112 DO l = 1, llm 113 x = 2.*asin(1.) * ( FLOAT(l)-0.5) / float(llm+1)113 x = 2.*asin(1.) * (REAL(l)-0.5) / REAL(llm+1) 114 114 115 115 IF (ok_strato) THEN … … 135 135 136 136 DO l=1,llm 137 nivsigs(l) = FLOAT(l)137 nivsigs(l) = REAL(l) 138 138 ENDDO 139 139 140 140 DO l=1,llmp1 141 nivsig(l)= FLOAT(l)141 nivsig(l)= REAL(l) 142 142 ENDDO 143 143 -
LMDZ4/trunk/libf/dyn3dpar/dynetat0.F
r1146 r1403 1 1 ! 2 ! $ Header$2 ! $Id $ 3 3 ! 4 4 SUBROUTINE dynetat0(fichnom,vcov,ucov, 5 5 . teta,q,masse,ps,phis,time) 6 6 7 USE infotrac 7 8 IMPLICIT NONE … … 33 34 #include "serre.h" 34 35 #include "logic.h" 36 #include "iniprint.h" 35 37 36 38 c Arguments: … … 52 54 53 55 c----------------------------------------------------------------------- 56 54 57 c Ouverture NetCDF du fichier etat initial 55 58 56 59 ierr = NF_OPEN (fichnom, NF_NOWRITE,nid) 57 60 IF (ierr.NE.NF_NOERR) THEN 58 write( 6,*)'Pb d''ouverture du fichier start.nc'59 write( 6,*)' ierr = ', ierr61 write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc' 62 write(lunout,*)' ierr = ', ierr 60 63 CALL ABORT 61 64 ENDIF … … 64 67 ierr = NF_INQ_VARID (nid, "controle", nvarid) 65 68 IF (ierr .NE. NF_NOERR) THEN 66 PRINT*,"dynetat0: Le champ <controle> est absent"69 write(lunout,*)"dynetat0: Le champ <controle> est absent" 67 70 CALL abort 68 71 ENDIF … … 73 76 #endif 74 77 IF (ierr .NE. NF_NOERR) THEN 75 PRINT*,"dynetat0: Lecture echoue pour <controle>"78 write(lunout,*)"dynetat0: Lecture echoue pour <controle>" 76 79 CALL abort 77 80 ENDIF … … 119 122 c 120 123 c 121 PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa 124 write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa', 125 & rad,omeg,g,cpp,kappa 122 126 123 127 IF( im.ne.iim ) THEN … … 134 138 ierr = NF_INQ_VARID (nid, "rlonu", nvarid) 135 139 IF (ierr .NE. NF_NOERR) THEN 136 PRINT*,"dynetat0: Le champ <rlonu> est absent"140 write(lunout,*)"dynetat0: Le champ <rlonu> est absent" 137 141 CALL abort 138 142 ENDIF … … 143 147 #endif 144 148 IF (ierr .NE. NF_NOERR) THEN 145 PRINT*,"dynetat0: Lecture echouee pour <rlonu>"149 write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>" 146 150 CALL abort 147 151 ENDIF … … 149 153 ierr = NF_INQ_VARID (nid, "rlatu", nvarid) 150 154 IF (ierr .NE. NF_NOERR) THEN 151 PRINT*,"dynetat0: Le champ <rlatu> est absent"155 write(lunout,*)"dynetat0: Le champ <rlatu> est absent" 152 156 CALL abort 153 157 ENDIF … … 158 162 #endif 159 163 IF (ierr .NE. NF_NOERR) THEN 160 PRINT*,"dynetat0: Lecture echouee pour <rlatu>"164 write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>" 161 165 CALL abort 162 166 ENDIF … … 164 168 ierr = NF_INQ_VARID (nid, "rlonv", nvarid) 165 169 IF (ierr .NE. NF_NOERR) THEN 166 PRINT*,"dynetat0: Le champ <rlonv> est absent"170 write(lunout,*)"dynetat0: Le champ <rlonv> est absent" 167 171 CALL abort 168 172 ENDIF … … 173 177 #endif 174 178 IF (ierr .NE. NF_NOERR) THEN 175 PRINT*,"dynetat0: Lecture echouee pour <rlonv>"179 write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>" 176 180 CALL abort 177 181 ENDIF … … 179 183 ierr = NF_INQ_VARID (nid, "rlatv", nvarid) 180 184 IF (ierr .NE. NF_NOERR) THEN 181 PRINT*,"dynetat0: Le champ <rlatv> est absent"185 write(lunout,*)"dynetat0: Le champ <rlatv> est absent" 182 186 CALL abort 183 187 ENDIF … … 188 192 #endif 189 193 IF (ierr .NE. NF_NOERR) THEN 190 PRINT*,"dynetat0: Lecture echouee pour rlatv"194 write(lunout,*)"dynetat0: Lecture echouee pour rlatv" 191 195 CALL abort 192 196 ENDIF … … 194 198 ierr = NF_INQ_VARID (nid, "cu", nvarid) 195 199 IF (ierr .NE. NF_NOERR) THEN 196 PRINT*,"dynetat0: Le champ <cu> est absent"200 write(lunout,*)"dynetat0: Le champ <cu> est absent" 197 201 CALL abort 198 202 ENDIF … … 203 207 #endif 204 208 IF (ierr .NE. NF_NOERR) THEN 205 PRINT*,"dynetat0: Lecture echouee pour <cu>"209 write(lunout,*)"dynetat0: Lecture echouee pour <cu>" 206 210 CALL abort 207 211 ENDIF … … 209 213 ierr = NF_INQ_VARID (nid, "cv", nvarid) 210 214 IF (ierr .NE. NF_NOERR) THEN 211 PRINT*,"dynetat0: Le champ <cv> est absent"215 write(lunout,*)"dynetat0: Le champ <cv> est absent" 212 216 CALL abort 213 217 ENDIF … … 218 222 #endif 219 223 IF (ierr .NE. NF_NOERR) THEN 220 PRINT*,"dynetat0: Lecture echouee pour <cv>"224 write(lunout,*)"dynetat0: Lecture echouee pour <cv>" 221 225 CALL abort 222 226 ENDIF … … 224 228 ierr = NF_INQ_VARID (nid, "aire", nvarid) 225 229 IF (ierr .NE. NF_NOERR) THEN 226 PRINT*,"dynetat0: Le champ <aire> est absent"230 write(lunout,*)"dynetat0: Le champ <aire> est absent" 227 231 CALL abort 228 232 ENDIF … … 233 237 #endif 234 238 IF (ierr .NE. NF_NOERR) THEN 235 PRINT*,"dynetat0: Lecture echouee pour <aire>"239 write(lunout,*)"dynetat0: Lecture echouee pour <aire>" 236 240 CALL abort 237 241 ENDIF … … 239 243 ierr = NF_INQ_VARID (nid, "phisinit", nvarid) 240 244 IF (ierr .NE. NF_NOERR) THEN 241 PRINT*,"dynetat0: Le champ <phisinit> est absent"245 write(lunout,*)"dynetat0: Le champ <phisinit> est absent" 242 246 CALL abort 243 247 ENDIF … … 248 252 #endif 249 253 IF (ierr .NE. NF_NOERR) THEN 250 PRINT*,"dynetat0: Lecture echouee pour <phisinit>"254 write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>" 251 255 CALL abort 252 256 ENDIF … … 254 258 ierr = NF_INQ_VARID (nid, "temps", nvarid) 255 259 IF (ierr .NE. NF_NOERR) THEN 256 PRINT*,"dynetat0: Le champ <temps> est absent"260 write(lunout,*)"dynetat0: Le champ <temps> est absent" 257 261 CALL abort 258 262 ENDIF … … 263 267 #endif 264 268 IF (ierr .NE. NF_NOERR) THEN 265 PRINT*,"dynetat0: Lecture echouee <temps>"269 write(lunout,*)"dynetat0: Lecture echouee <temps>" 266 270 CALL abort 267 271 ENDIF … … 269 273 ierr = NF_INQ_VARID (nid, "ucov", nvarid) 270 274 IF (ierr .NE. NF_NOERR) THEN 271 PRINT*,"dynetat0: Le champ <ucov> est absent"275 write(lunout,*)"dynetat0: Le champ <ucov> est absent" 272 276 CALL abort 273 277 ENDIF … … 278 282 #endif 279 283 IF (ierr .NE. NF_NOERR) THEN 280 PRINT*,"dynetat0: Lecture echouee pour <ucov>"284 write(lunout,*)"dynetat0: Lecture echouee pour <ucov>" 281 285 CALL abort 282 286 ENDIF … … 284 288 ierr = NF_INQ_VARID (nid, "vcov", nvarid) 285 289 IF (ierr .NE. NF_NOERR) THEN 286 PRINT*,"dynetat0: Le champ <vcov> est absent"290 write(lunout,*)"dynetat0: Le champ <vcov> est absent" 287 291 CALL abort 288 292 ENDIF … … 293 297 #endif 294 298 IF (ierr .NE. NF_NOERR) THEN 295 PRINT*,"dynetat0: Lecture echouee pour <vcov>"299 write(lunout,*)"dynetat0: Lecture echouee pour <vcov>" 296 300 CALL abort 297 301 ENDIF … … 299 303 ierr = NF_INQ_VARID (nid, "teta", nvarid) 300 304 IF (ierr .NE. NF_NOERR) THEN 301 PRINT*,"dynetat0: Le champ <teta> est absent"305 write(lunout,*)"dynetat0: Le champ <teta> est absent" 302 306 CALL abort 303 307 ENDIF … … 308 312 #endif 309 313 IF (ierr .NE. NF_NOERR) THEN 310 PRINT*, "dynetat0: Lecture echouee pour <teta>" 311 CALL abort 312 ENDIF 313 314 314 write(lunout,*)"dynetat0: Lecture echouee pour <teta>" 315 CALL abort 316 ENDIF 317 318 319 IF(nqtot.GE.1) THEN 315 320 DO iq=1,nqtot 316 321 ierr = NF_INQ_VARID (nid, tname(iq), nvarid) 317 322 IF (ierr .NE. NF_NOERR) THEN 318 PRINT*, "dynetat0: Le champ <"//tname(iq)//"> est absent" 319 PRINT*, " Il est donc initialise a zero" 323 write(lunout,*)"dynetat0: Le champ <"//tname(iq)// 324 & "> est absent" 325 write(lunout,*)" Il est donc initialise a zero" 320 326 q(:,:,iq)=0. 321 327 ELSE … … 326 332 #endif 327 333 IF (ierr .NE. NF_NOERR) THEN 328 PRINT*,"dynetat0: Lecture echouee pour "//tname(iq)329 334 write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq) 335 CALL abort 330 336 ENDIF 331 337 ENDIF 332 338 ENDDO 339 ENDIF 333 340 334 341 ierr = NF_INQ_VARID (nid, "masse", nvarid) 335 342 IF (ierr .NE. NF_NOERR) THEN 336 PRINT*,"dynetat0: Le champ <masse> est absent"343 write(lunout,*)"dynetat0: Le champ <masse> est absent" 337 344 CALL abort 338 345 ENDIF … … 343 350 #endif 344 351 IF (ierr .NE. NF_NOERR) THEN 345 PRINT*,"dynetat0: Lecture echouee pour <masse>"352 write(lunout,*)"dynetat0: Lecture echouee pour <masse>" 346 353 CALL abort 347 354 ENDIF … … 349 356 ierr = NF_INQ_VARID (nid, "ps", nvarid) 350 357 IF (ierr .NE. NF_NOERR) THEN 351 PRINT*,"dynetat0: Le champ <ps> est absent"358 write(lunout,*)"dynetat0: Le champ <ps> est absent" 352 359 CALL abort 353 360 ENDIF … … 358 365 #endif 359 366 IF (ierr .NE. NF_NOERR) THEN 360 PRINT*,"dynetat0: Lecture echouee pour <ps>"367 write(lunout,*)"dynetat0: Lecture echouee pour <ps>" 361 368 CALL abort 362 369 ENDIF -
LMDZ4/trunk/libf/dyn3dpar/dynredem.F
r1279 r1403 8 8 #endif 9 9 USE infotrac 10 10 11 IMPLICIT NONE 11 12 c======================================================================= … … 25 26 #include "description.h" 26 27 #include "serre.h" 28 #include "iniprint.h" 27 29 28 30 c Arguments: … … 72 74 tab_cntrl(l) = 0. 73 75 ENDDO 74 tab_cntrl(1) = FLOAT(iim)75 tab_cntrl(2) = FLOAT(jjm)76 tab_cntrl(3) = FLOAT(llm)77 tab_cntrl(4) = FLOAT(day_ref)78 tab_cntrl(5) = FLOAT(annee_ref)76 tab_cntrl(1) = REAL(iim) 77 tab_cntrl(2) = REAL(jjm) 78 tab_cntrl(3) = REAL(llm) 79 tab_cntrl(4) = REAL(day_ref) 80 tab_cntrl(5) = REAL(annee_ref) 79 81 tab_cntrl(6) = rad 80 82 tab_cntrl(7) = omeg … … 116 118 ENDIF 117 119 118 tab_cntrl(30) = FLOAT(iday_end)119 tab_cntrl(31) = FLOAT(itau_dyn + itaufin)120 tab_cntrl(30) = REAL(iday_end) 121 tab_cntrl(31) = REAL(itau_dyn + itaufin) 120 122 c 121 123 c ......................................................... … … 125 127 ierr = NF_CREATE(fichnom, NF_CLOBBER, nid) 126 128 IF (ierr.NE.NF_NOERR) THEN 127 WRITE(6,*)" Pb d ouverture du fichier "//fichnom 128 WRITE(6,*)' ierr = ', ierr 129 write(lunout,*)"dynredem0: Pb d ouverture du fichier " 130 & //trim(fichnom) 131 write(lunout,*)' ierr = ', ierr 129 132 CALL ABORT 130 133 ENDIF … … 508 511 ierr = NF_CLOSE(nid) ! fermer le fichier 509 512 510 PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end 511 PRINT*,'rad,omeg,g,cpp,kappa', 512 , rad,omeg,g,cpp,kappa 513 write(lunout,*)'dynredem0: iim,jjm,llm,iday_end', 514 & iim,jjm,llm,iday_end 515 write(lunout,*)'dynredem0: rad,omeg,g,cpp,kappa', 516 & rad,omeg,g,cpp,kappa 513 517 514 518 RETURN … … 517 521 . vcov,ucov,teta,q,masse,ps) 518 522 USE infotrac 523 USE control_mod 524 519 525 IMPLICIT NONE 520 526 c================================================================= … … 528 534 #include "comgeom.h" 529 535 #include "temps.h" 530 #include "control.h" 536 #include "iniprint.h" 537 531 538 532 539 INTEGER l … … 555 562 ierr = NF_OPEN(fichnom, NF_WRITE, nid) 556 563 IF (ierr .NE. NF_NOERR) THEN 557 PRINT*, "Pb. d ouverture "//fichnom564 write(lunout,*)"dynredem1: Pb. d ouverture "//trim(fichnom) 558 565 CALL abort 559 566 ENDIF … … 564 571 ierr = NF_INQ_VARID(nid, "temps", nvarid) 565 572 IF (ierr .NE. NF_NOERR) THEN 566 print *,NF_STRERROR(ierr)573 write(lunout,*) NF_STRERROR(ierr) 567 574 abort_message='Variable temps n est pas definie' 568 575 CALL abort_gcm(modname,abort_message,ierr) … … 573 580 ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time) 574 581 #endif 575 PRINT*, "Enregistrement pour ", nb, time582 write(lunout,*) "dynredem1: Enregistrement pour ", nb, time 576 583 577 584 c … … 589 596 ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl) 590 597 #endif 591 tab_cntrl(31) = FLOAT(itau_dyn + itaufin)598 tab_cntrl(31) = REAL(itau_dyn + itaufin) 592 599 #ifdef NC_DOUBLE 593 600 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl) … … 600 607 ierr = NF_INQ_VARID(nid, "ucov", nvarid) 601 608 IF (ierr .NE. NF_NOERR) THEN 602 PRINT*, "Variable ucov n est pas definie" 603 CALL abort 609 abort_message="Variable ucov n est pas definie" 610 ierr=1 611 CALL abort_gcm(modname,abort_message,ierr) 604 612 ENDIF 605 613 #ifdef NC_DOUBLE … … 611 619 ierr = NF_INQ_VARID(nid, "vcov", nvarid) 612 620 IF (ierr .NE. NF_NOERR) THEN 613 PRINT*, "Variable vcov n est pas definie" 614 CALL abort 621 abort_message="Variable vcov n est pas definie" 622 ierr=1 623 CALL abort_gcm(modname,abort_message,ierr) 615 624 ENDIF 616 625 #ifdef NC_DOUBLE … … 622 631 ierr = NF_INQ_VARID(nid, "teta", nvarid) 623 632 IF (ierr .NE. NF_NOERR) THEN 624 PRINT*, "Variable teta n est pas definie" 625 CALL abort 633 abort_message="Variable teta n est pas definie" 634 ierr=1 635 CALL abort_gcm(modname,abort_message,ierr) 626 636 ENDIF 627 637 #ifdef NC_DOUBLE … … 635 645 ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac) 636 646 IF (ierr_file .NE.NF_NOERR) THEN 637 write(6,*)' Pb d''ouverture du fichier start_trac.nc' 638 write(6,*)' ierr = ', ierr_file 647 write(lunout,*)'dynredem1: Pb d''ouverture du fichier', 648 & ' start_trac.nc' 649 write(lunout,*)' ierr = ', ierr_file 639 650 ENDIF 640 651 END IF … … 646 657 ierr = NF_INQ_VARID(nid, tname(iq), nvarid) 647 658 IF (ierr .NE. NF_NOERR) THEN 648 PRINT*, "Variable tname(iq) n est pas definie" 649 CALL abort 659 abort_message="Variable tname(iq) n est pas definie" 660 ierr=1 661 CALL abort_gcm(modname,abort_message,ierr) 650 662 ENDIF 651 663 #ifdef NC_DOUBLE … … 659 671 ierr = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac) 660 672 IF (ierr .NE. NF_NOERR) THEN 661 PRINT*, tname(iq),"est absent de start_trac.nc" 673 write(lunout,*) "dynredem1: ",trim(tname(iq)), 674 & " est absent de start_trac.nc" 662 675 ierr = NF_INQ_VARID(nid, tname(iq), nvarid) 663 676 IF (ierr .NE. NF_NOERR) THEN 664 PRINT*, "Variable ", tname(iq)," n est pas definie" 665 CALL abort 677 abort_message="dynredem1: Variable "// 678 & trim(tname(iq))//" n est pas definie" 679 ierr=1 680 CALL abort_gcm(modname,abort_message,ierr) 666 681 ENDIF 667 682 #ifdef NC_DOUBLE … … 672 687 673 688 ELSE 674 PRINT*, tname(iq), "est present dans start_trac.nc" 689 write(lunout,*) "dynredem1: ",trim(tname(iq)), 690 & " est present dans start_trac.nc" 675 691 #ifdef NC_DOUBLE 676 692 ierr = NF_GET_VAR_DOUBLE(nid_trac, nvarid_trac, trac_tmp) … … 679 695 #endif 680 696 IF (ierr .NE. NF_NOERR) THEN 681 PRINT*, "Lecture echouee pour", tname(iq) 682 CALL abort 697 abort_message="dynredem1: Lecture echouee pour"// 698 & trim(tname(iq)) 699 ierr=1 700 CALL abort_gcm(modname,abort_message,ierr) 683 701 ENDIF 684 702 ierr = NF_INQ_VARID(nid, tname(iq), nvarid) 685 703 IF (ierr .NE. NF_NOERR) THEN 686 PRINT*, "Variable ", tname(iq)," n est pas definie" 687 CALL abort 704 abort_message="dynredem1: Variable "// 705 & trim(tname(iq))//" n est pas definie" 706 ierr=1 707 CALL abort_gcm(modname,abort_message,ierr) 688 708 ENDIF 689 709 #ifdef NC_DOUBLE … … 699 719 ierr = NF_INQ_VARID(nid, tname(iq), nvarid) 700 720 IF (ierr .NE. NF_NOERR) THEN 701 PRINT*, "Variable tname(iq) n est pas definie" 702 CALL abort 721 abort_message="dynredem1: Variable "// 722 & trim(tname(iq))//" n est pas definie" 723 ierr=1 724 CALL abort_gcm(modname,abort_message,ierr) 703 725 ENDIF 704 726 #ifdef NC_DOUBLE … … 715 737 ierr = NF_INQ_VARID(nid, "masse", nvarid) 716 738 IF (ierr .NE. NF_NOERR) THEN 717 PRINT*, "Variable masse n est pas definie" 718 CALL abort 739 abort_message="dynredem1: Variable masse n est pas definie" 740 ierr=1 741 CALL abort_gcm(modname,abort_message,ierr) 719 742 ENDIF 720 743 #ifdef NC_DOUBLE … … 726 749 ierr = NF_INQ_VARID(nid, "ps", nvarid) 727 750 IF (ierr .NE. NF_NOERR) THEN 728 PRINT*, "Variable ps n est pas definie" 729 CALL abort 751 abort_message="dynredem1: Variable ps n est pas definie" 752 ierr=1 753 CALL abort_gcm(modname,abort_message,ierr) 730 754 ENDIF 731 755 #ifdef NC_DOUBLE -
LMDZ4/trunk/libf/dyn3dpar/dynredem_p.F
r1279 r1403 74 74 tab_cntrl(l) = 0. 75 75 ENDDO 76 tab_cntrl(1) = FLOAT(iim)77 tab_cntrl(2) = FLOAT(jjm)78 tab_cntrl(3) = FLOAT(llm)79 tab_cntrl(4) = FLOAT(day_ref)80 tab_cntrl(5) = FLOAT(annee_ref)76 tab_cntrl(1) = REAL(iim) 77 tab_cntrl(2) = REAL(jjm) 78 tab_cntrl(3) = REAL(llm) 79 tab_cntrl(4) = REAL(day_ref) 80 tab_cntrl(5) = REAL(annee_ref) 81 81 tab_cntrl(6) = rad 82 82 tab_cntrl(7) = omeg … … 118 118 ENDIF 119 119 120 tab_cntrl(30) = FLOAT(iday_end)121 tab_cntrl(31) = FLOAT(itau_dyn + itaufin)120 tab_cntrl(30) = REAL(iday_end) 121 tab_cntrl(31) = REAL(itau_dyn + itaufin) 122 122 c 123 123 c ......................................................... … … 521 521 USE parallel 522 522 USE infotrac 523 USE control_mod 523 524 IMPLICIT NONE 524 525 c================================================================= … … 532 533 #include "comgeom.h" 533 534 #include "temps.h" 534 #include "control.h"535 535 536 536 INTEGER l … … 608 608 ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl) 609 609 #endif 610 tab_cntrl(31) = FLOAT(itau_dyn + itaufin)610 tab_cntrl(31) = REAL(itau_dyn + itaufin) 611 611 #ifdef NC_DOUBLE 612 612 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl) -
LMDZ4/trunk/libf/dyn3dpar/etat0_netcdf.F90
r1328 r1403 24 24 USE netcdf, ONLY : NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR 25 25 #endif 26 USE control_mod 26 27 IMPLICIT NONE 27 28 !------------------------------------------------------------------------------- … … 72 73 73 74 #include "comdissnew.h" 74 #include "control.h"75 75 #include "serre.h" 76 76 #include "clesphys.h" … … 103 103 REAL :: tau_thermals, solarlong0, seuil_inversion 104 104 INTEGER :: read_climoz ! read ozone climatology 105 REAL :: alp_offset 105 106 ! Allowed values are 0, 1 and 2 106 107 ! 0: do not read an ozone climatology … … 132 133 iflag_thermals,nsplit_thermals,tau_thermals, & 133 134 iflag_thermals_ed,iflag_thermals_optflux, & 134 iflag_coupl,iflag_clos,iflag_wake, read_climoz ) 135 iflag_coupl,iflag_clos,iflag_wake, read_climoz, & 136 alp_offset) 135 137 136 138 ! co2_ppm0 : initial value of atmospheric CO2 from .def file (co2_ppm value) -
LMDZ4/trunk/libf/dyn3dpar/exner_hyb.F
r774 r1403 1 1 ! 2 ! $ Header$2 ! $Id $ 3 3 ! 4 4 SUBROUTINE exner_hyb ( ngrid, ps, p,alpha,beta, pks, pk, pkf ) … … 51 51 REAL SSUM 52 52 c 53 54 if (llm.eq.1) then 55 ! Specific behaviour for Shallow Water (1 vertical layer) case 53 56 57 ! Sanity checks 58 if (kappa.ne.1) then 59 call abort_gcm("exner_hyb", 60 & "kappa!=1 , but running in Shallow Water mode!!",42) 61 endif 62 if (cpp.ne.r) then 63 call abort_gcm("exner_hyb", 64 & "cpp!=r , but running in Shallow Water mode!!",42) 65 endif 66 67 ! Compute pks(:),pk(:),pkf(:) 68 69 DO ij = 1, ngrid 70 pks(ij) = (cpp/preff) * ps(ij) 71 pk(ij,1) = .5*pks(ij) 72 ENDDO 73 74 CALL SCOPY ( ngrid * llm, pk, 1, pkf, 1 ) 75 CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 ) 76 77 ! our work is done, exit routine 78 return 79 endif ! of if (llm.eq.1) 80 81 54 82 unpl2k = 1.+ 2.* kappa 55 83 c -
LMDZ4/trunk/libf/dyn3dpar/exner_hyb_p.F
r985 r1403 1 ! 2 ! $Id $ 3 ! 1 4 SUBROUTINE exner_hyb_p ( ngrid, ps, p,alpha,beta, pks, pk, pkf ) 2 5 c … … 51 54 INTEGER ije,ijb,jje,jjb 52 55 c 53 c$OMP BARRIER 56 c$OMP BARRIER 57 58 if (llm.eq.1) then 59 ! Specific behaviour for Shallow Water (1 vertical layer) case 60 61 ! Sanity checks 62 if (kappa.ne.1) then 63 call abort_gcm("exner_hyb", 64 & "kappa!=1 , but running in Shallow Water mode!!",42) 65 endif 66 if (cpp.ne.r) then 67 call abort_gcm("exner_hyb", 68 & "cpp!=r , but running in Shallow Water mode!!",42) 69 endif 70 71 ! Compute pks(:),pk(:),pkf(:) 72 ijb=ij_begin 73 ije=ij_end 74 !$OMP DO SCHEDULE(STATIC) 75 DO ij=ijb, ije 76 pks(ij)=(cpp/preff)*ps(ij) 77 pk(ij,1) = .5*pks(ij) 78 pkf(ij,1)=pk(ij,1) 79 ENDDO 80 !$OMP ENDDO 81 82 !$OMP MASTER 83 if (pole_nord) then 84 DO ij = 1, iim 85 ppn(ij) = aire( ij ) * pks( ij ) 86 ENDDO 87 xpn = SSUM(iim,ppn,1) /apoln 88 89 DO ij = 1, iip1 90 pks( ij ) = xpn 91 pk(ij,1) = .5*pks(ij) 92 pkf(ij,1)=pk(ij,1) 93 ENDDO 94 endif 95 96 if (pole_sud) then 97 DO ij = 1, iim 98 pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm ) 99 ENDDO 100 xps = SSUM(iim,pps,1) /apols 101 102 DO ij = 1, iip1 103 pks( ij+ip1jm ) = xps 104 pk(ij+ip1jm,1)=.5*pks(ij+ip1jm) 105 pkf(ij+ip1jm,1)=pk(ij+ip1jm,1) 106 ENDDO 107 endif 108 !$OMP END MASTER 109 110 jjb=jj_begin 111 jje=jj_end 112 CALL filtreg_p ( pkf,jjb,jje, jmp1, llm, 2, 1, .TRUE., 1 ) 113 114 ! our work is done, exit routine 115 return 116 endif ! of if (llm.eq.1) 117 118 54 119 unpl2k = 1.+ 2.* kappa 55 120 c -
LMDZ4/trunk/libf/dyn3dpar/extrapol.F
r774 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 C … … 158 158 jlat = jy(k) 159 159 pwork(i,j) = pwork(i,j) 160 $ + pfild(ilon,jlat) * zmask(k)/ FLOAT(inbor)160 $ + pfild(ilon,jlat) * zmask(k)/ REAL(inbor) 161 161 ENDDO 162 162 ENDIF -
LMDZ4/trunk/libf/dyn3dpar/fluxstokenc_p.F
r1279 r1403 4 4 SUBROUTINE fluxstokenc_p(pbaru,pbarv,masse,teta,phi,phis, 5 5 . time_step,itau ) 6 #ifdef CPP_ EARTH7 ! This routine is designed to work for Earth andwith ioipsl6 #ifdef CPP_IOIPSL 7 ! This routine is designed to work with ioipsl 8 8 9 9 USE IOIPSL … … 153 153 DO l=1,llm 154 154 DO ij = ijb,ije 155 pbaruc(ij,l) = pbaruc(ij,l)/ float(istdyn)156 tetac(ij,l) = tetac(ij,l)/ float(istdyn)157 phic(ij,l) = phic(ij,l)/ float(istdyn)155 pbaruc(ij,l) = pbaruc(ij,l)/REAL(istdyn) 156 tetac(ij,l) = tetac(ij,l)/REAL(istdyn) 157 phic(ij,l) = phic(ij,l)/REAL(istdyn) 158 158 ENDDO 159 159 ENDDO … … 165 165 DO l=1,llm 166 166 DO ij = ijb,ije 167 pbarvc(ij,l) = pbarvc(ij,l)/ float(istdyn)167 pbarvc(ij,l) = pbarvc(ij,l)/REAL(istdyn) 168 168 ENDDO 169 169 ENDDO … … 202 202 203 203 iadvtr=0 204 Print*,'ITAU auqel on stoke les fluxmasses',itau204 write(lunout,*)'ITAU auquel on stoke les fluxmasses',itau 205 205 206 206 ijb=ij_begin … … 244 244 #else 245 245 write(lunout,*) 246 & 'fluxstokenc: Needs Earth physics (and ioipsl)to function'246 & 'fluxstokenc: Needs IOIPSL to function' 247 247 #endif 248 ! of #ifdef CPP_ EARTH248 ! of #ifdef CPP_IOIPSL 249 249 RETURN 250 250 END -
LMDZ4/trunk/libf/dyn3dpar/friction_p.F
r774 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c======================================================================= 5 5 SUBROUTINE friction_p(ucov,vcov,pdt) 6 6 USE parallel 7 USE control_mod 7 8 IMPLICIT NONE 8 9 … … 22 23 #include "paramet.h" 23 24 #include "comgeom2.h" 24 #include "control.h"25 25 #include "comconst.h" 26 26 -
LMDZ4/trunk/libf/dyn3dpar/fxhyp.F
r764 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 89 89 90 90 DO i = 0, nmax2 91 xtild(i) = - pi + FLOAT(i) * depi /nmax291 xtild(i) = - pi + REAL(i) * depi /nmax2 92 92 ENDDO 93 93 … … 235 235 DO 1500 i = ii1, ii2 236 236 237 xlon2 = - pi + ( FLOAT(i) + xuv - decalx) * depi / FLOAT(iim)237 xlon2 = - pi + (REAL(i) + xuv - decalx) * depi / REAL(iim) 238 238 239 239 Xfi = xlon2 … … 280 280 550 CONTINUE 281 281 282 xxprim(i) = depi/ ( FLOAT(iim) * Xprimin )282 xxprim(i) = depi/ ( REAL(iim) * Xprimin ) 283 283 xvrai(i) = xi + xzoom 284 284 -
LMDZ4/trunk/libf/dyn3dpar/fxy.F
r774 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE fxy (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1, … … 32 32 c 33 33 DO j = 1, jjm + 1 34 rlatu(j) = fy ( FLOAT( j ) )35 yprimu(j) = fyprim( FLOAT( j ) )34 rlatu(j) = fy ( REAL( j ) ) 35 yprimu(j) = fyprim( REAL( j ) ) 36 36 ENDDO 37 37 … … 39 39 DO j = 1, jjm 40 40 41 rlatv(j) = fy ( FLOAT( j ) + 0.5 )42 rlatu1(j) = fy ( FLOAT( j ) + 0.25 )43 rlatu2(j) = fy ( FLOAT( j ) + 0.75 )41 rlatv(j) = fy ( REAL( j ) + 0.5 ) 42 rlatu1(j) = fy ( REAL( j ) + 0.25 ) 43 rlatu2(j) = fy ( REAL( j ) + 0.75 ) 44 44 45 yprimv(j) = fyprim( FLOAT( j ) + 0.5 )46 yprimu1(j) = fyprim( FLOAT( j ) + 0.25 )47 yprimu2(j) = fyprim( FLOAT( j ) + 0.75 )45 yprimv(j) = fyprim( REAL( j ) + 0.5 ) 46 yprimu1(j) = fyprim( REAL( j ) + 0.25 ) 47 yprimu2(j) = fyprim( REAL( j ) + 0.75 ) 48 48 49 49 ENDDO … … 53 53 c 54 54 DO i = 1, iim + 1 55 rlonv(i) = fx ( FLOAT( i ) )56 rlonu(i) = fx ( FLOAT( i ) + 0.5 )57 rlonm025(i) = fx ( FLOAT( i ) - 0.25 )58 rlonp025(i) = fx ( FLOAT( i ) + 0.25 )55 rlonv(i) = fx ( REAL( i ) ) 56 rlonu(i) = fx ( REAL( i ) + 0.5 ) 57 rlonm025(i) = fx ( REAL( i ) - 0.25 ) 58 rlonp025(i) = fx ( REAL( i ) + 0.25 ) 59 59 60 xprimv (i) = fxprim ( FLOAT( i ) )61 xprimu (i) = fxprim ( FLOAT( i ) + 0.5 )62 xprimm025(i) = fxprim ( FLOAT( i ) - 0.25 )63 xprimp025(i) = fxprim ( FLOAT( i ) + 0.25 )60 xprimv (i) = fxprim ( REAL( i ) ) 61 xprimu (i) = fxprim ( REAL( i ) + 0.5 ) 62 xprimm025(i) = fxprim ( REAL( i ) - 0.25 ) 63 xprimp025(i) = fxprim ( REAL( i ) + 0.25 ) 64 64 ENDDO 65 65 -
LMDZ4/trunk/libf/dyn3dpar/fxysinus.F
r774 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE fxysinus (rlatu,yprimu,rlatv,yprimv,rlatu1,yprimu1, … … 32 32 c 33 33 DO j = 1, jjm + 1 34 rlatu(j) = fy ( FLOAT( j ) )35 yprimu(j) = fyprim( FLOAT( j ) )34 rlatu(j) = fy ( REAL( j ) ) 35 yprimu(j) = fyprim( REAL( j ) ) 36 36 ENDDO 37 37 … … 39 39 DO j = 1, jjm 40 40 41 rlatv(j) = fy ( FLOAT( j ) + 0.5 )42 rlatu1(j) = fy ( FLOAT( j ) + 0.25 )43 rlatu2(j) = fy ( FLOAT( j ) + 0.75 )41 rlatv(j) = fy ( REAL( j ) + 0.5 ) 42 rlatu1(j) = fy ( REAL( j ) + 0.25 ) 43 rlatu2(j) = fy ( REAL( j ) + 0.75 ) 44 44 45 yprimv(j) = fyprim( FLOAT( j ) + 0.5 )46 yprimu1(j) = fyprim( FLOAT( j ) + 0.25 )47 yprimu2(j) = fyprim( FLOAT( j ) + 0.75 )45 yprimv(j) = fyprim( REAL( j ) + 0.5 ) 46 yprimu1(j) = fyprim( REAL( j ) + 0.25 ) 47 yprimu2(j) = fyprim( REAL( j ) + 0.75 ) 48 48 49 49 ENDDO … … 53 53 c 54 54 DO i = 1, iim + 1 55 rlonv(i) = fx ( FLOAT( i ) )56 rlonu(i) = fx ( FLOAT( i ) + 0.5 )57 rlonm025(i) = fx ( FLOAT( i ) - 0.25 )58 rlonp025(i) = fx ( FLOAT( i ) + 0.25 )55 rlonv(i) = fx ( REAL( i ) ) 56 rlonu(i) = fx ( REAL( i ) + 0.5 ) 57 rlonm025(i) = fx ( REAL( i ) - 0.25 ) 58 rlonp025(i) = fx ( REAL( i ) + 0.25 ) 59 59 60 xprimv (i) = fxprim ( FLOAT( i ) )61 xprimu (i) = fxprim ( FLOAT( i ) + 0.5 )62 xprimm025(i) = fxprim ( FLOAT( i ) - 0.25 )63 xprimp025(i) = fxprim ( FLOAT( i ) + 0.25 )60 xprimv (i) = fxprim ( REAL( i ) ) 61 xprimu (i) = fxprim ( REAL( i ) + 0.5 ) 62 xprimm025(i) = fxprim ( REAL( i ) - 0.25 ) 63 xprimp025(i) = fxprim ( REAL( i ) + 0.25 ) 64 64 ENDDO 65 65 -
LMDZ4/trunk/libf/dyn3dpar/fyhyp.F
r1279 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 75 75 depi = 2. * pi 76 76 pis2 = pi/2. 77 pisjm = pi/ FLOAT(jjm)77 pisjm = pi/ REAL(jjm) 78 78 epsilon = 1.e-3 79 79 y0 = yzoomdeg * pi/180. … … 94 94 95 95 DO i = 0, nmax2 96 yt(i) = - pis2 + FLOAT(i)* pi /nmax296 yt(i) = - pis2 + REAL(i)* pi /nmax2 97 97 ENDDO 98 98 … … 210 210 DO 1500 j = 1,jlat 211 211 yo1 = 0. 212 ylon2 = - pis2 + pisjm * ( FLOAT(j) + yuv -1.)212 ylon2 = - pis2 + pisjm * ( REAL(j) + yuv -1.) 213 213 yfi = ylon2 214 214 c -
LMDZ4/trunk/libf/dyn3dpar/gcm.F
r1315 r1403 18 18 USE getparam 19 19 USE filtreg_mod 20 USE control_mod 20 21 21 22 ! Ehouarn: for now these only apply to Earth: … … 66 67 #include "logic.h" 67 68 #include "temps.h" 68 #include "control.h"69 69 #include "ener.h" 70 70 #include "description.h" 71 71 #include "serre.h" 72 #include "com_io_dyn.h"72 !#include "com_io_dyn.h" 73 73 #include "iniprint.h" 74 74 #include "tracstoke.h" 75 76 #ifdef INCA 77 ! Only INCA needs these informations (from the Earth's physics) 75 78 #include "indicesol.h" 79 #endif 76 80 77 81 INTEGER longcles … … 267 271 if (read_start) then 268 272 ! we still need to run iniacademic to initialize some 269 ! constants & fields, if we run the 'newtonian' case:270 if (iflag_phys. eq.2) then273 ! constants & fields, if we run the 'newtonian' or 'SW' cases: 274 if (iflag_phys.ne.1) then 271 275 CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0) 272 276 endif 273 !#ifdef CPP_IOIPSL 277 274 278 if (planet_type.eq."earth") then 275 279 #ifdef CPP_EARTH 276 280 ! Load an Earth-format start file 277 281 CALL dynetat0("start.nc",vcov,ucov, 278 . teta,q,masse,ps,phis, time_0) 282 & teta,q,masse,ps,phis, time_0) 283 #else 284 ! SW model also has Earth-format start files 285 ! (but can be used without the CPP_EARTH directive) 286 if (iflag_phys.eq.0) then 287 CALL dynetat0("start.nc",vcov,ucov, 288 & teta,q,masse,ps,phis, time_0) 289 endif 279 290 #endif 280 291 endif ! of if (planet_type.eq."earth") … … 311 322 ENDIF 312 323 313 zdtvr = daysec/ FLOAT(day_step)324 zdtvr = daysec/REAL(day_step) 314 325 IF(dtvr.NE.zdtvr) THEN 315 326 WRITE(lunout,*) … … 320 331 C on remet le calendrier à zero si demande 321 332 c 322 if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then 333 IF (raz_date == 1) THEN 334 annee_ref = anneeref 335 day_ref = dayref 336 day_ini = dayref 337 itau_dyn = 0 338 itau_phy = 0 339 time_0 = 0. 340 write(lunout,*) 341 . 'GCM: On reinitialise a la date lue dans gcm.def' 342 ELSE IF (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN 323 343 write(lunout,*) 324 344 . 'GCM: Attention les dates initiales lues dans le fichier' … … 326 346 . ' restart ne correspondent pas a celles lues dans ' 327 347 write(lunout,*)' gcm.def' 328 write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref 329 write(lunout,*)' day_ref=',day_ref," dayref=",dayref 330 if (raz_date .ne. 1) then 331 write(lunout,*) 332 . 'GCM: On garde les dates du fichier restart' 333 else 334 annee_ref = anneeref 335 day_ref = dayref 336 day_ini = dayref 337 itau_dyn = 0 338 itau_phy = 0 339 time_0 = 0. 340 write(lunout,*) 341 . 'GCM: On reinitialise a la date lue dans gcm.def' 342 endif 343 ELSE 344 raz_date = 0 345 endif 348 write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref 349 write(lunout,*)' day_ref=',day_ref," dayref=",dayref 350 write(lunout,*)' Pas de remise a zero' 351 ENDIF 352 c if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then 353 c write(lunout,*) 354 c . 'GCM: Attention les dates initiales lues dans le fichier' 355 c write(lunout,*) 356 c . ' restart ne correspondent pas a celles lues dans ' 357 c write(lunout,*)' gcm.def' 358 c write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref 359 c write(lunout,*)' day_ref=',day_ref," dayref=",dayref 360 c if (raz_date .ne. 1) then 361 c write(lunout,*) 362 c . 'GCM: On garde les dates du fichier restart' 363 c else 364 c annee_ref = anneeref 365 c day_ref = dayref 366 c day_ini = dayref 367 c itau_dyn = 0 368 c itau_phy = 0 369 c time_0 = 0. 370 c write(lunout,*) 371 c . 'GCM: On reinitialise a la date lue dans gcm.def' 372 c endif 373 c ELSE 374 c raz_date = 0 375 c endif 346 376 347 377 #ifdef CPP_IOIPSL … … 372 402 nbetatmoy = nday / periodav + 1 373 403 404 if (iflag_phys.eq.1) then 405 ! these initialisations have already been done (via iniacademic) 406 ! if running in SW or Newtonian mode 374 407 c----------------------------------------------------------------------- 375 408 c Initialisation des constantes dynamiques : 376 409 c ------------------------------------------ 377 dtvr = zdtvr378 CALL iniconst410 dtvr = zdtvr 411 CALL iniconst 379 412 380 413 c----------------------------------------------------------------------- 381 414 c Initialisation de la geometrie : 382 415 c -------------------------------- 383 CALL inigeom416 CALL inigeom 384 417 385 418 c----------------------------------------------------------------------- 386 419 c Initialisation du filtre : 387 420 c -------------------------- 388 CALL inifilr 421 CALL inifilr 422 endif ! of if (iflag_phys.eq.1) 389 423 c 390 424 c----------------------------------------------------------------------- … … 422 456 if (planet_type.eq."earth") then 423 457 #ifdef CPP_EARTH 424 CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys ,458 CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys , 425 459 , latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp ) 426 460 #endif … … 467 501 468 502 #ifdef CPP_IOIPSL 469 if ( 1.eq.1) then470 503 time_step = zdtvr 471 t_ops = iecri * daysec 472 t_wrt = iecri * daysec 473 ! CALL inithist_p(dynhist_file,day_ref,annee_ref,time_step, 474 ! . t_ops, t_wrt, histid, histvid) 475 476 IF (ok_dynzon) THEN 477 t_ops = iperiod * time_step 478 t_wrt = periodav * daysec 504 IF (mpi_rank==0) then 505 if (ok_dyn_ins) then 506 ! initialize output file for instantaneous outputs 507 ! t_ops = iecri * daysec ! do operations every t_ops 508 t_ops =((1.0*iecri)/day_step) * daysec 509 t_wrt = daysec ! iecri * daysec ! write output every t_wrt 510 t_wrt = daysec ! iecri * daysec ! write output every t_wrt 511 CALL inithist(day_ref,annee_ref,time_step, 512 & t_ops,t_wrt) 513 endif 514 515 IF (ok_dyn_ave) THEN 516 ! initialize output file for averaged outputs 517 t_ops = iperiod * time_step ! do operations every t_ops 518 t_wrt = periodav * daysec ! write output every t_wrt 519 CALL initdynav(day_ref,annee_ref,time_step, 520 & t_ops,t_wrt) 479 521 ! CALL initdynav_p(dynhistave_file,day_ref,annee_ref,time_step, 480 522 ! . t_ops, t_wrt, histaveid) 481 END IF 523 END IF 524 ENDIF 482 525 dtav = iperiod*dtvr/daysec 483 endif484 485 486 526 #endif 487 527 ! #endif of #ifdef CPP_IOIPSL -
LMDZ4/trunk/libf/dyn3dpar/grid_atob.F
r1279 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE grille_m(imdep, jmdep, xdata, ydata, entree, … … 717 717 c Calculs intermediares: 718 718 c 719 xtmp(1) = -180.0 + 360.0/ FLOAT(imtmp) / 2.0719 xtmp(1) = -180.0 + 360.0/REAL(imtmp) / 2.0 720 720 DO i = 2, imtmp 721 xtmp(i) = xtmp(i-1) + 360.0/ FLOAT(imtmp)721 xtmp(i) = xtmp(i-1) + 360.0/REAL(imtmp) 722 722 ENDDO 723 723 DO i = 1, imtmp 724 724 xtmp(i) = xtmp(i) /180.0 * 4.0*ATAN(1.0) 725 725 ENDDO 726 ytmp(1) = -90.0 + 180.0/ FLOAT(jmtmp) / 2.0726 ytmp(1) = -90.0 + 180.0/REAL(jmtmp) / 2.0 727 727 DO j = 2, jmtmp 728 ytmp(j) = ytmp(j-1) + 180.0/ FLOAT(jmtmp)728 ytmp(j) = ytmp(j-1) + 180.0/REAL(jmtmp) 729 729 ENDDO 730 730 DO j = 1, jmtmp -
LMDZ4/trunk/libf/dyn3dpar/grid_noro.F
r764 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 93 93 xpi=acos(-1.) 94 94 rad = 6 371 229. 95 zdeltay=2.*xpi/ float(jusn)*rad95 zdeltay=2.*xpi/REAL(jusn)*rad 96 96 c 97 97 c utilise-t'on un masque lu? … … 215 215 c SUMMATION OVER GRIDPOINT AREA 216 216 c 217 zleny=xpi/ float(jusn)*rad218 xincr=xpi/2./ float(jusn)217 zleny=xpi/REAL(jusn)*rad 218 xincr=xpi/2./REAL(jusn) 219 219 DO ii = 1, imar+1 220 220 DO jj = 1, jmar … … 468 468 DO IS=-1,1 469 469 DO JS=-1,1 470 WEIGHTpb(IS,JS)=1./ FLOAT((1+IS**2)*(1+JS**2))470 WEIGHTpb(IS,JS)=1./REAL((1+IS**2)*(1+JS**2)) 471 471 SUM=SUM+WEIGHTpb(IS,JS) 472 472 ENDDO -
LMDZ4/trunk/libf/dyn3dpar/grilles_gcm_netcdf.F
r764 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 218 218 open (20,file='grille.dat',form='unformatted',access='direct' 219 219 s ,recl=4*ip1jmp1) 220 write(20,rec=1) (( float(mod(i,2)+mod(j,2)),i=1,iip1),j=1,jjp1)221 write(20,rec=2) (( float(mod(i,2)*mod(j,2)),i=1,iip1),j=1,jjp1)220 write(20,rec=1) (( REAL(mod(i,2)+mod(j,2)),i=1,iip1),j=1,jjp1) 221 write(20,rec=2) (( REAL(mod(i,2)*mod(j,2)),i=1,iip1),j=1,jjp1) 222 222 do j=2,jjm 223 223 dlat1(j)=180.*(rlatv(j)-rlatv(j-1))/pi 224 c dlat2(j)=180.*fyprim( float(j))/pi224 c dlat2(j)=180.*fyprim( REAL(j))/pi 225 225 enddo 226 226 do i=2,iip1 227 227 dlon1(i)=180.*(rlonu(i)-rlonu(i-1))/pi 228 c dlon2(i)=180.*fxprim( float(i))/pi228 c dlon2(i)=180.*fxprim( REAL(i))/pi 229 229 enddo 230 230 do j=2,jjm -
LMDZ4/trunk/libf/dyn3dpar/guide_p_mod.F90
r1304 r1403 1 1 ! 2 ! $ Header: /home/cvsroot/LMDZ4/libf/dyn3d/guide.F,v 1.3.4.1 2006/11/06 15:51:16 fairhead Exp$2 ! $Id$ 3 3 ! 4 4 MODULE guide_p_mod … … 66 66 SUBROUTINE guide_init 67 67 68 USE control_mod 68 69 IMPLICIT NONE 69 70 … … 71 72 INCLUDE "paramet.h" 72 73 INCLUDE "netcdf.inc" 73 INCLUDE "control.h"74 74 75 75 INTEGER :: error,ncidpl,rid,rcod … … 274 274 SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps) 275 275 use parallel 276 USE control_mod 276 277 277 278 IMPLICIT NONE … … 279 280 INCLUDE "dimensions.h" 280 281 INCLUDE "paramet.h" 281 INCLUDE "control.h"282 282 INCLUDE "comconst.h" 283 283 INCLUDE "comvert.h" … … 380 380 dday_step=real(day_step) 381 381 IF (iguide_read.LT.0) THEN 382 tau=ditau/dday_step/ FLOAT(iguide_read)382 tau=ditau/dday_step/ REAL(iguide_read) 383 383 ELSE 384 tau= FLOAT(iguide_read)*ditau/dday_step384 tau= REAL(iguide_read)*ditau/dday_step 385 385 ENDIF 386 386 reste=tau-AINT(tau) … … 580 580 ENDDO 581 581 ENDDO 582 fieldm(:,l)=fieldm(:,l)/ FLOAT(imax(typ)-imin(typ)+1)582 fieldm(:,l)=fieldm(:,l)/ REAL(imax(typ)-imin(typ)+1) 583 583 ! Compute forcing 584 584 DO j=jjb_v,jje_v … … 598 598 ENDDO 599 599 ENDDO 600 fieldm(:,l)=fieldm(:,l)/ FLOAT(imax(typ)-imin(typ)+1)600 fieldm(:,l)=fieldm(:,l)/ REAL(imax(typ)-imin(typ)+1) 601 601 ! Compute forcing 602 602 DO j=jjb_u,jje_u -
LMDZ4/trunk/libf/dyn3dpar/infotrac.F90
r1279 r1403 31 31 32 32 SUBROUTINE infotrac_init 33 USE control_mod 33 34 IMPLICIT NONE 34 35 !======================================================================= … … 49 50 50 51 INCLUDE "dimensions.h" 51 INCLUDE "control.h"52 52 INCLUDE "iniprint.h" 53 53 -
LMDZ4/trunk/libf/dyn3dpar/iniacademic.F
r1279 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 8 8 USE filtreg_mod 9 9 USE infotrac, ONLY : nqtot 10 USE control_mod 11 10 12 11 13 c%W% %G% … … 44 46 #include "ener.h" 45 47 #include "temps.h" 46 #include "control.h"47 48 #include "iniprint.h" 49 #include "logic.h" 48 50 49 51 c Arguments: … … 55 57 REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants 56 58 REAL teta(ip1jmp1,llm) ! temperature potentielle 57 REAL q(ip1jmp1,llm,nqtot) ! champs advectes59 REAL q(ip1jmp1,llm,nqtot) ! champs advectes 58 60 REAL ps(ip1jmp1) ! pression au sol 59 61 REAL masse(ip1jmp1,llm) ! masse d'air … … 84 86 time_0=0. 85 87 day_ref=0 86 88 annee_ref=0 87 89 88 90 im = iim … … 93 95 g = 9.8 94 96 daysec = 86400. 95 dtvr = daysec/ FLOAT(day_step)97 dtvr = daysec/REAL(day_step) 96 98 zdtvr=dtvr 97 99 kappa = 0.2857143 … … 105 107 ang0 = 0. 106 108 109 if (llm.eq.1) then 110 ! specific initializations for the shallow water case 111 kappa=1 112 endif 113 107 114 CALL iniconst 108 115 CALL inigeom 109 116 CALL inifilr 110 117 111 ps=0. 112 phis=0. 118 if (llm.eq.1) then 119 ! initialize fields for the shallow water case, if required 120 if (.not.read_start) then 121 phis(:)=0. 122 q(:,:,1)=1.e-10 123 q(:,:,2)=1.e-15 124 q(:,:,3:nqtot)=0. 125 CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps) 126 endif 127 endif 128 129 if (iflag_phys.eq.2) then 130 ! initializations for the academic case 131 ps(:)=1.e5 132 phis(:)=0. 113 133 c--------------------------------------------------------------------- 114 134 115 taurappel=10.*daysec135 taurappel=10.*daysec 116 136 117 137 c--------------------------------------------------------------------- … … 119 139 c -------------------------------------- 120 140 121 DO l=1,llm122 zsig=ap(l)/preff+bp(l)123 if (zsig.gt.0.3) then124 lsup=l125 tetarappell=1./8.*(-log(zsig)-.5)126 DO j=1,jjp1141 DO l=1,llm 142 zsig=ap(l)/preff+bp(l) 143 if (zsig.gt.0.3) then 144 lsup=l 145 tetarappell=1./8.*(-log(zsig)-.5) 146 DO j=1,jjp1 127 147 ddsin=sin(rlatu(j))-sin(pi/20.) 128 148 tetajl(j,l)=300.*(1+1./18.*(1.-3.*ddsin*ddsin)+tetarappell) 129 ENDDO130 else149 ENDDO 150 else 131 151 c Choix isotherme au-dessus de 300 mbar 132 do j=1,jjp1133 tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa134 enddo135 endif ! of if (zsig.gt.0.3)136 ENDDO ! of DO l=1,llm137 138 do l=1,llm139 do j=1,jjp1152 do j=1,jjp1 153 tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa 154 enddo 155 endif ! of if (zsig.gt.0.3) 156 ENDDO ! of DO l=1,llm 157 158 do l=1,llm 159 do j=1,jjp1 140 160 do i=1,iip1 141 161 ij=(j-1)*iip1+i 142 162 tetarappel(ij,l)=tetajl(j,l) 143 163 enddo 144 enddo145 enddo164 enddo 165 enddo 146 166 147 167 c call dump2d(jjp1,llm,tetajl,'TEQ ') 148 168 149 ps=1.e5 150 phis=0. 151 CALL pression ( ip1jmp1, ap, bp, ps, p ) 152 CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf ) 153 CALL massdair(p,masse) 169 CALL pression ( ip1jmp1, ap, bp, ps, p ) 170 CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf ) 171 CALL massdair(p,masse) 154 172 155 173 c intialisation du vent et de la temperature 156 teta(:,:)=tetarappel(:,:)157 CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)158 call ugeostr(phi,ucov)159 vcov=0.160 q(:,:,1 )=1.e-10161 q(:,:,2 )=1.e-15162 q(:,:,3:nqtot)=0.174 teta(:,:)=tetarappel(:,:) 175 CALL geopot(ip1jmp1,teta,pk,pks,phis,phi) 176 call ugeostr(phi,ucov) 177 vcov=0. 178 q(:,:,1 )=1.e-10 179 q(:,:,2 )=1.e-15 180 q(:,:,3:nqtot)=0. 163 181 164 182 165 183 c perturbation aleatoire sur la temperature 166 idum = -1167 zz = ran1(idum)168 idum = 0169 do l=1,llm170 do ij=iip2,ip1jm184 idum = -1 185 zz = ran1(idum) 186 idum = 0 187 do l=1,llm 188 do ij=iip2,ip1jm 171 189 teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum)) 172 enddo173 enddo174 175 do l=1,llm176 do ij=1,ip1jmp1,iip1190 enddo 191 enddo 192 193 do l=1,llm 194 do ij=1,ip1jmp1,iip1 177 195 teta(ij+iim,l)=teta(ij,l) 178 enddo179 enddo196 enddo 197 enddo 180 198 181 199 … … 187 205 188 206 c initialisation d'un traceur sur une colonne 189 j=jjp1*3/4 190 i=iip1/2 191 ij=(j-1)*iip1+i 192 q(ij,:,3)=1. 193 207 j=jjp1*3/4 208 i=iip1/2 209 ij=(j-1)*iip1+i 210 q(ij,:,3)=1. 211 endif ! of if (iflag_phys.eq.2) 212 194 213 else 195 214 write(lunout,*)"iniacademic: planet types other than earth", -
LMDZ4/trunk/libf/dyn3dpar/iniconst.F
r774 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE iniconst 5 6 USE control_mod 5 7 6 8 IMPLICIT NONE … … 16 18 #include "comconst.h" 17 19 #include "temps.h" 18 #include "control.h"19 20 #include "comvert.h" 21 #include "iniprint.h" 20 22 21 23 … … 47 49 r = cpp * kappa 48 50 49 PRINT*,'R CP Kappa ', r , cpp, kappa51 write(lunout,*)'iniconst: R CP Kappa ', r , cpp, kappa 50 52 c 51 53 c----------------------------------------------------------------------- -
LMDZ4/trunk/libf/dyn3dpar/inidissip.F
r1279 r1403 11 11 c ------------- 12 12 13 USE control_mod 14 13 15 IMPLICIT NONE 14 16 #include "dimensions.h" … … 17 19 #include "comconst.h" 18 20 #include "comvert.h" 19 #include "control.h"20 21 #include "logic.h" 21 22 … … 165 166 166 167 c IF(.NOT.lstardis) THEN 167 fact = rad*24./ float(jjm)168 fact = rad*24./REAL(jjm) 168 169 fact = fact*fact 169 170 PRINT*,'coef u ', fact/cdivu, 1./cdivu -
LMDZ4/trunk/libf/dyn3dpar/inigeom.F
r774 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 168 168 c 169 169 IF( nitergdiv.NE.2 ) THEN 170 gamdi_gdiv = coefdis/ ( float(nitergdiv) -2. )170 gamdi_gdiv = coefdis/ ( REAL(nitergdiv) -2. ) 171 171 ELSE 172 172 gamdi_gdiv = 0. 173 173 ENDIF 174 174 IF( nitergrot.NE.2 ) THEN 175 gamdi_grot = coefdis/ ( float(nitergrot) -2. )175 gamdi_grot = coefdis/ ( REAL(nitergrot) -2. ) 176 176 ELSE 177 177 gamdi_grot = 0. 178 178 ENDIF 179 179 IF( niterh.NE.2 ) THEN 180 gamdi_h = coefdis/ ( float(niterh) -2. )180 gamdi_h = coefdis/ ( REAL(niterh) -2. ) 181 181 ELSE 182 182 gamdi_h = 0. … … 381 381 yprp = yprimu2(j-1) 382 382 rlatp = rlatu2 (j-1) 383 ccc yprp = fyprim( FLOAT(j) - 0.25 )384 ccc rlatp = fy ( FLOAT(j) - 0.25 )383 ccc yprp = fyprim( REAL(j) - 0.25 ) 384 ccc rlatp = fy ( REAL(j) - 0.25 ) 385 385 c 386 386 coslatp = COS( rlatp ) … … 416 416 rlatm = rlatu1 ( j ) 417 417 yprm = yprimu1( j ) 418 cc rlatp = fy ( FLOAT(j) - 0.25 )419 cc yprp = fyprim( FLOAT(j) - 0.25 )420 cc rlatm = fy ( FLOAT(j) + 0.25 )421 cc yprm = fyprim( FLOAT(j) + 0.25 )418 cc rlatp = fy ( REAL(j) - 0.25 ) 419 cc yprp = fyprim( REAL(j) - 0.25 ) 420 cc rlatm = fy ( REAL(j) + 0.25 ) 421 cc yprm = fyprim( REAL(j) + 0.25 ) 422 422 423 423 coslatm = COS( rlatm ) -
LMDZ4/trunk/libf/dyn3dpar/integrd_p.F
r1279 r1403 6 6 $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis,finvmaold) 7 7 USE parallel 8 USE control_mod 8 9 IMPLICIT NONE 9 10 … … 32 33 #include "temps.h" 33 34 #include "serre.h" 34 #include "control.h"35 35 36 36 c Arguments: -
LMDZ4/trunk/libf/dyn3dpar/interpre.F
r774 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 subroutine interpre(q,qppm,w,fluxwppm,masse, … … 6 6 s unatppm,vnatppm,psppm) 7 7 8 implicit none 8 USE control_mod 9 implicit none 9 10 10 11 #include "dimensions.h" … … 17 18 #include "logic.h" 18 19 #include "temps.h" 19 #include "control.h"20 20 #include "ener.h" 21 21 #include "description.h" -
LMDZ4/trunk/libf/dyn3dpar/leapfrog_p.F
r1286 r1403 20 20 USE guide_p_mod, ONLY : guide_main 21 21 USE getparam 22 USE control_mod 22 23 23 24 IMPLICIT NONE … … 62 63 #include "logic.h" 63 64 #include "temps.h" 64 #include "control.h"65 65 #include "ener.h" 66 66 #include "description.h" 67 67 #include "serre.h" 68 #include "com_io_dyn.h"68 !#include "com_io_dyn.h" 69 69 #include "iniprint.h" 70 70 #include "academic.h" … … 212 212 itau = 0 213 213 ! iday = day_ini+itau/day_step 214 ! time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0214 ! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 215 215 ! IF(time.GT.1.) THEN 216 216 ! time = time-1. … … 352 352 c idissip=1 353 353 IF( purmats ) THEN 354 ! Purely Matsuno time stepping 354 355 IF( MOD(itau,iconser) .EQ.0.AND. forward ) conser = .TRUE. 355 356 IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE. … … 357 358 s .and. iflag_phys.EQ.1 ) apphys = .TRUE. 358 359 ELSE 360 ! Leapfrog/Matsuno time stepping 359 361 IF( MOD(itau ,iconser) .EQ. 0 ) conser = .TRUE. 360 362 IF( MOD(itau+1,idissip) .EQ. 0 ) apdiss = .TRUE. … … 362 364 END IF 363 365 366 ! Ehouarn: for Shallow Water case (ie: 1 vertical layer), 367 ! supress dissipation step 368 if (llm.eq.1) then 369 apdiss=.false. 370 endif 371 364 372 cym ---> Pour le moment 365 373 cym apphys = .FALSE. 366 374 statcl = .FALSE. 367 conser = .FALSE. 375 conser = .FALSE. ! ie: no output of control variables to stdout in // 368 376 369 377 if (firstCaldyn) then … … 677 685 call suspend_timer(timer_caldyn) 678 686 687 if (prt_level >= 10) then 679 688 write(lunout,*) 680 689 & 'leapfrog_p: Entree dans la physique : Iteration No ',true_itau 690 endif 681 691 c$OMP END MASTER 682 692 … … 964 974 ijb=ij_begin 965 975 ije=ij_end 966 teta(ijb:ije,:)=teta(ijb:ije,:) 967 s -iphysiq*dtvr*(teta(ijb:ije,:)-tetarappel(ijb:ije,:))/taurappel 976 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 977 do l=1,llm 978 teta(ijb:ije,l)=teta(ijb:ije,l) 979 & -iphysiq*dtvr*(teta(ijb:ije,l)-tetarappel(ijb:ije,l))/taurappel 980 enddo 981 !$OMP END DO 968 982 969 983 call Register_Hallo(ucov,ip1jmp1,llm,0,1,1,0,Request_Physic) … … 972 986 c$OMP BARRIER 973 987 call WaitRequest(Request_Physic) 974 988 c$OMP BARRIER 989 !$OMP MASTER 975 990 call friction_p(ucov,vcov,iphysiq*dtvr) 991 !$OMP END MASTER 992 !$OMP BARRIER 976 993 ENDIF ! of IF(iflag_phys.EQ.2) 977 994 … … 1089 1106 enddo 1090 1107 c$OMP END DO NOWAIT 1091 endif 1108 endif ! of if (dissip_conservative) 1092 1109 1093 1110 ijb=ij_begin … … 1198 1215 c$OMP END MASTER 1199 1216 c$OMP BARRIER 1200 END IF 1217 END IF ! of IF(apdiss) 1201 1218 1202 1219 cc$OMP END PARALLEL … … 1280 1297 itau= itau + 1 1281 1298 ! iday= day_ini+itau/day_step 1282 ! time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_01299 ! time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 1283 1300 ! IF(time.GT.1.) THEN 1284 1301 ! time = time-1. … … 1337 1354 ENDIF !ok_dynzon 1338 1355 #endif 1339 ENDIF 1356 IF (ok_dyn_ave) THEN 1357 !$OMP MASTER 1358 #ifdef CPP_IOIPSL 1359 ! Ehouarn: Gather fields and make master send to output 1360 call Gather_Field(vcov,ip1jm,llm,0) 1361 call Gather_Field(ucov,ip1jmp1,llm,0) 1362 call Gather_Field(teta,ip1jmp1,llm,0) 1363 call Gather_Field(pk,ip1jmp1,llm,0) 1364 call Gather_Field(phi,ip1jmp1,llm,0) 1365 do iq=1,nqtot 1366 call Gather_Field(q(1,1,iq),ip1jmp1,llm,0) 1367 enddo 1368 call Gather_Field(masse,ip1jmp1,llm,0) 1369 call Gather_Field(ps,ip1jmp1,1,0) 1370 call Gather_Field(phis,ip1jmp1,1,0) 1371 if (mpi_rank==0) then 1372 CALL writedynav(itau,vcov, 1373 & ucov,teta,pk,phi,q,masse,ps,phis) 1374 endif 1375 #endif 1376 !$OMP END MASTER 1377 ENDIF ! of IF (ok_dyn_ave) 1378 ENDIF ! of IF((MOD(itau,iperiod).EQ.0).OR.(itau.EQ.itaufin)) 1340 1379 1341 1380 c----------------------------------------------------------------------- … … 1343 1382 c ------------------------------ 1344 1383 1345 c IF( MOD(itau,iecri).EQ.0) THEN1346 1347 IF( MOD(itau,iecri*day_step).EQ.0) THEN 1384 IF( MOD(itau,iecri).EQ.0) THEN 1385 ! Ehouarn: output only during LF or Backward Matsuno 1386 if (leapf.or.(.not.leapf.and.(.not.forward))) then 1348 1387 c$OMP BARRIER 1349 1388 c$OMP MASTER … … 1379 1418 1380 1419 #ifdef CPP_IOIPSL 1381 1420 if (ok_dyn_ins) then 1421 ! Ehouarn: Gather fields and make master write to output 1422 call Gather_Field(vcov,ip1jm,llm,0) 1423 call Gather_Field(ucov,ip1jmp1,llm,0) 1424 call Gather_Field(teta,ip1jmp1,llm,0) 1425 call Gather_Field(phi,ip1jmp1,llm,0) 1426 do iq=1,nqtot 1427 call Gather_Field(q(1,1,iq),ip1jmp1,llm,0) 1428 enddo 1429 call Gather_Field(masse,ip1jmp1,llm,0) 1430 call Gather_Field(ps,ip1jmp1,1,0) 1431 call Gather_Field(phis,ip1jmp1,1,0) 1432 if (mpi_rank==0) then 1433 CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis) 1434 endif 1382 1435 ! CALL writehist_p(histid,histvid, itau,vcov, 1383 1436 ! & ucov,teta,phi,q,masse,ps,phis) 1384 1437 ! or use writefield_p 1438 ! call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/))) 1439 ! call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/))) 1440 ! call WriteField_p('teta',reshape(teta,(/iip1,jmp1,llm/))) 1441 ! call WriteField_p('ps',reshape(ps,(/iip1,jmp1/))) 1442 endif ! of if (ok_dyn_ins) 1385 1443 #endif 1386 1444 ! For some Grads outputs of fields … … 1399 1457 endif ! of if (output_grads_dyn) 1400 1458 c$OMP END MASTER 1459 endif ! of if (leapf.or.(.not.leapf.and.(.not.forward))) 1401 1460 ENDIF ! of IF(MOD(itau,iecri).EQ.0) 1402 1461 … … 1458 1517 itau = itau + 1 1459 1518 ! iday = day_ini+itau/day_step 1460 ! time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_01519 ! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 1461 1520 ! 1462 1521 ! IF(time.GT.1.) THEN … … 1477 1536 GO TO 2 1478 1537 1479 ELSE ! of IF(forward) 1538 ELSE ! of IF(forward) i.e. backward step 1480 1539 1481 1540 IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN … … 1488 1547 IF (ok_dynzon) THEN 1489 1548 c$OMP BARRIER 1490 1491 1549 call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest) 1492 1550 call SendRequest(TestRequest) 1493 1551 c$OMP BARRIER 1494 1552 call WaitRequest(TestRequest) 1495 1496 1553 c$OMP BARRIER 1497 1554 c$OMP MASTER … … 1503 1560 END IF !ok_dynzon 1504 1561 #endif 1562 IF (ok_dyn_ave) THEN 1563 !$OMP MASTER 1564 #ifdef CPP_IOIPSL 1565 ! Ehouarn: Gather fields and make master send to output 1566 call Gather_Field(vcov,ip1jm,llm,0) 1567 call Gather_Field(ucov,ip1jmp1,llm,0) 1568 call Gather_Field(teta,ip1jmp1,llm,0) 1569 call Gather_Field(pk,ip1jmp1,llm,0) 1570 call Gather_Field(phi,ip1jmp1,llm,0) 1571 do iq=1,nqtot 1572 call Gather_Field(q(1,1,iq),ip1jmp1,llm,0) 1573 enddo 1574 call Gather_Field(masse,ip1jmp1,llm,0) 1575 call Gather_Field(ps,ip1jmp1,1,0) 1576 call Gather_Field(phis,ip1jmp1,1,0) 1577 if (mpi_rank==0) then 1578 CALL writedynav(itau,vcov, 1579 & ucov,teta,pk,phi,q,masse,ps,phis) 1580 endif 1581 #endif 1582 !$OMP END MASTER 1583 ENDIF ! of IF (ok_dyn_ave) 1584 1505 1585 ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) 1506 1586 1507 1587 1508 cIF(MOD(itau,iecri ).EQ.0) THEN1509 IF(MOD(itau,iecri*day_step).EQ.0) THEN1588 IF(MOD(itau,iecri ).EQ.0) THEN 1589 c IF(MOD(itau,iecri*day_step).EQ.0) THEN 1510 1590 c$OMP BARRIER 1511 1591 c$OMP MASTER … … 1540 1620 1541 1621 #ifdef CPP_IOIPSL 1542 1622 if (ok_dyn_ins) then 1623 ! Ehouarn: Gather fields and make master send to output 1624 call Gather_Field(vcov,ip1jm,llm,0) 1625 call Gather_Field(ucov,ip1jmp1,llm,0) 1626 call Gather_Field(teta,ip1jmp1,llm,0) 1627 call Gather_Field(phi,ip1jmp1,llm,0) 1628 do iq=1,nqtot 1629 call Gather_Field(q(1,1,iq),ip1jmp1,llm,0) 1630 enddo 1631 call Gather_Field(masse,ip1jmp1,llm,0) 1632 call Gather_Field(ps,ip1jmp1,1,0) 1633 call Gather_Field(phis,ip1jmp1,1,0) 1634 if (mpi_rank==0) then 1635 CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis) 1636 endif 1543 1637 ! CALL writehist_p(histid, histvid, itau,vcov , 1544 1638 ! & ucov,teta,phi,q,masse,ps,phis) 1639 endif ! of if (ok_dyn_ins) 1545 1640 #endif 1546 1641 ! For some Grads output (but does it work?) … … 1560 1655 1561 1656 c$OMP END MASTER 1562 ENDIF ! of IF(MOD(itau,iecri *day_step).EQ.0)1657 ENDIF ! of IF(MOD(itau,iecri).EQ.0) 1563 1658 1564 1659 IF(itau.EQ.itaufin) THEN -
LMDZ4/trunk/libf/dyn3dpar/limit_netcdf.F90
r1328 r1403 30 30 USE inter_barxy_m, only: inter_barxy 31 31 #endif 32 USE control_mod 32 33 IMPLICIT NONE 33 34 !------------------------------------------------------------------------------- … … 45 46 !------------------------------------------------------------------------------- 46 47 ! Local variables: 47 #include "control.h"48 48 #include "logic.h" 49 49 #include "comvert.h" … … 293 293 USE dimphy, ONLY : klon 294 294 USE phys_state_var_mod, ONLY : pctsrf 295 USE control_mod 295 296 IMPLICIT NONE 296 297 #include "dimensions.h" 297 298 #include "paramet.h" 298 299 #include "comgeom2.h" 299 #include "control.h"300 300 #include "indicesol.h" 301 301 #include "iniprint.h" -
LMDZ4/trunk/libf/dyn3dpar/ppm3d.F
r764 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 … … 345 345 C 346 346 PI = 4. * ATAN(1.) 347 DL = 2.*PI / float(IMR)348 DP = PI / float(JMR)347 DL = 2.*PI / REAL(IMR) 348 DP = PI / REAL(JMR) 349 349 C 350 350 if(IGD.eq.0) then … … 388 388 ZTC = acos(CR1) * (180./PI) 389 389 C 390 JS0 = float(JMR)*(90.-ZTC)/180. + 2390 JS0 = REAL(JMR)*(90.-ZTC)/180. + 2 391 391 JS0 = max(JS0, J1+1) 392 392 IML = min(6*JS0/(J1-1)+2, 4*IMR/5) … … 628 628 C Contribution from the N-S advection 629 629 do i=1,imr*(j2-j1+1) 630 JT = float(J1) - VA(i,j1)630 JT = REAL(J1) - VA(i,j1) 631 631 wk1(i,j1,2) = VA(i,j1) * (q(i,jt,k,IC) - q(i,jt+1,k,IC)) 632 632 enddo … … 949 949 IF(IORD.eq.1 .or. j.eq.j1. or. j.eq.j2) THEN 950 950 DO 1406 i=1,IMR 951 iu = float(i) - uc(i,j)951 iu = REAL(i) - uc(i,j) 952 952 1406 fx1(i) = qtmp(iu) 953 953 ELSE … … 957 957 if(IORD.eq.2 .or. j.le.j1vl .or. j.ge.j2vl) then 958 958 DO 1408 i=1,IMR 959 iu = float(i) - uc(i,j)959 iu = REAL(i) - uc(i,j) 960 960 1408 fx1(i) = qtmp(iu) + DC(iu)*(sign(1.,uc(i,j))-uc(i,j)) 961 961 else … … 1111 1111 if(JORD.eq.1) then 1112 1112 DO 1000 i=1,len 1113 JT = float(J1) - VC(i,J1)1113 JT = REAL(J1) - VC(i,J1) 1114 1114 1000 fx(i,j1) = p(i,JT) 1115 1115 else … … 1123 1123 else 1124 1124 DO 1200 i=1,len 1125 JT = float(J1) - VC(i,J1)1125 JT = REAL(J1) - VC(i,J1) 1126 1126 1200 fx(i,j1) = p(i,JT) + (sign(1.,VC(i,j1))-VC(i,j1))*DC2(i,JT) 1127 1127 endif … … 1358 1358 do j=j1-1,j2+1 1359 1359 do i=1,imr 1360 JP = float(j)-VA(i,j)1360 JP = REAL(j)-VA(i,j) 1361 1361 ady(i,j) = VA(i,j)*(wk(i,jp)-wk(i,jp+1)) 1362 1362 enddo … … 1582 1582 JMR = JNP-1 1583 1583 do 55 j=2,JNP 1584 ph5 = -0.5*PI + ( FLOAT(J-1)-0.5)*DP1584 ph5 = -0.5*PI + (REAL(J-1)-0.5)*DP 1585 1585 55 cose(j) = cos(ph5) 1586 1586 C … … 1834 1834 C 1835 1835 c if(first) then 1836 DP = 4.*ATAN(1.)/ float(JNP-1)1836 DP = 4.*ATAN(1.)/REAL(JNP-1) 1837 1837 CAP1 = IMR*(1.-COS((j1-1.5)*DP))/DP 1838 1838 c first = .false. … … 1889 1889 C Check Poles. 1890 1890 if(q(1,1).lt.0.) then 1891 dq = q(1,1)*cap1/ float(IMR)*acosp(j1)1891 dq = q(1,1)*cap1/REAL(IMR)*acosp(j1) 1892 1892 do i=1,imr 1893 1893 q(i,1) = 0. … … 1898 1898 C 1899 1899 if(q(1,JNP).lt.0.) then 1900 dq = q(1,JNP)*cap1/ float(IMR)*acosp(j2)1900 dq = q(1,JNP)*cap1/REAL(IMR)*acosp(j2) 1901 1901 do i=1,imr 1902 1902 q(i,JNP) = 0. -
LMDZ4/trunk/libf/dyn3dpar/ran1.F
r774 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 FUNCTION RAN1(IDUM) … … 20 20 IX1=MOD(IA1*IX1+IC1,M1) 21 21 IX2=MOD(IA2*IX2+IC2,M2) 22 R(J)=( FLOAT(IX1)+FLOAT(IX2)*RM2)*RM122 R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1 23 23 11 CONTINUE 24 24 IDUM=1 … … 30 30 IF(J.GT.97.OR.J.LT.1)PAUSE 31 31 RAN1=R(J) 32 R(J)=( FLOAT(IX1)+FLOAT(IX2)*RM2)*RM132 R(J)=(REAL(IX1)+REAL(IX2)*RM2)*RM1 33 33 RETURN 34 34 END -
LMDZ4/trunk/libf/dyn3dpar/sortvarc.F
r1279 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE sortvarc … … 59 59 60 60 dtvrs1j = dtvr/daysec 61 rjour = FLOAT( INT( itau * dtvrs1j ))61 rjour = REAL( INT( itau * dtvrs1j )) 62 62 heure = ( itau*dtvrs1j-rjour ) * 24. 63 63 imjmp1 = iim * jjp1 … … 129 129 ang = SSUM( llm, angl, 1 ) 130 130 131 c rday = FLOAT(INT ( day_ini + time ))131 c rday = REAL(INT ( day_ini + time )) 132 132 c 133 rday = FLOAT(INT(time-jD_ref-jH_ref))133 rday = REAL(INT(time-jD_ref-jH_ref)) 134 134 IF(ptot0.eq.0.) THEN 135 135 PRINT 3500, itau, rday, heure,time -
LMDZ4/trunk/libf/dyn3dpar/sortvarc0.F
r1279 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE sortvarc0 … … 60 60 61 61 dtvrs1j = dtvr/daysec 62 rjour = FLOAT( INT( itau * dtvrs1j ))62 rjour = REAL( INT( itau * dtvrs1j )) 63 63 heure = ( itau*dtvrs1j-rjour ) * 24. 64 64 imjmp1 = iim * jjp1 … … 130 130 ang0 = SSUM( llm, angl, 1 ) 131 131 132 rday = FLOAT(INT (time ))132 rday = REAL(INT (time )) 133 133 c 134 134 PRINT 3500, itau, rday, heure, time -
LMDZ4/trunk/libf/dyn3dpar/tourabs.F
r763 r1403 57 57 ELSE 58 58 rot( ij,l ) = (vcov(ij+1,l)/cv(ij+1)-vcov(ij,l)/cv(ij))/ 59 $ (2.*pi*RAD*cos(rlatv(j)))* float(iim)59 $ (2.*pi*RAD*cos(rlatv(j)))*REAL(iim) 60 60 $ +(ucov(ij+iip1,l)/cu(ij+iip1)-ucov(ij,l)/cu(ij))/ 61 $ (pi*RAD)*( float(jjm)-1.)61 $ (pi*RAD)*(REAL(jjm)-1.) 62 62 c 63 63 ENDIF -
LMDZ4/trunk/libf/dyn3dpar/traceurpole.F
r774 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 subroutine traceurpole(q,masse) 5 6 USE control_mod 5 7 6 8 implicit none … … 15 17 #include "logic.h" 16 18 #include "temps.h" 17 #include "control.h"18 19 #include "ener.h" 19 20 #include "description.h" -
LMDZ4/trunk/libf/dyn3dpar/ugeostr.F
r1279 r1403 40 40 DO i=1,iim 41 41 u(i,j,l)=fact*(phi(i,j+1,l)-phi(i,j,l)) 42 um(j,l)=um(j,l)+u(i,j,l)/ float(iim)42 um(j,l)=um(j,l)+u(i,j,l)/REAL(iim) 43 43 ENDDO 44 44 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
