Changeset 1403 for LMDZ4/trunk/libf/dyn3d
- Timestamp:
- Jul 1, 2010, 11:02:53 AM (15 years ago)
- Location:
- LMDZ4/trunk
- Files:
-
- 4 deleted
- 45 edited
- 3 copied
-
. (modified) (1 prop)
-
libf/dyn3d/adaptdt.F (modified) (2 diffs)
-
libf/dyn3d/advtrac.F (modified) (3 diffs)
-
libf/dyn3d/bilan_dyn.F (modified) (1 diff)
-
libf/dyn3d/caladvtrac.F (modified) (3 diffs)
-
libf/dyn3d/calfis.F (modified) (9 diffs)
-
libf/dyn3d/ce0l.F90 (modified) (2 diffs)
-
libf/dyn3d/com_io_dyn.h (deleted)
-
libf/dyn3d/com_io_dyn_mod.F90 (copied) (copied from LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/com_io_dyn_mod.F90)
-
libf/dyn3d/conf_gcm.F (modified) (8 diffs)
-
libf/dyn3d/control.h (deleted)
-
libf/dyn3d/control_mod.F90 (copied) (copied from LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/control_mod.F90)
-
libf/dyn3d/defrun.F (modified) (4 diffs)
-
libf/dyn3d/disvert.F (modified) (2 diffs)
-
libf/dyn3d/dynetat0.F (modified) (36 diffs)
-
libf/dyn3d/dynredem.F (modified) (23 diffs)
-
libf/dyn3d/etat0_netcdf.F90 (modified) (4 diffs)
-
libf/dyn3d/exner_hyb.F (modified) (2 diffs)
-
libf/dyn3d/extrapol.F (modified) (2 diffs)
-
libf/dyn3d/fluxstokenc.F (modified) (4 diffs)
-
libf/dyn3d/friction.F (modified) (2 diffs)
-
libf/dyn3d/fxhyp.F (modified) (4 diffs)
-
libf/dyn3d/fxy.F (modified) (4 diffs)
-
libf/dyn3d/fxysinus.F (modified) (4 diffs)
-
libf/dyn3d/fyhyp.F (modified) (4 diffs)
-
libf/dyn3d/gcm.F (modified) (10 diffs)
-
libf/dyn3d/grid_atob.F (modified) (2 diffs)
-
libf/dyn3d/grid_noro.F (modified) (4 diffs)
-
libf/dyn3d/grilles_gcm_netcdf.F (modified) (2 diffs)
-
libf/dyn3d/guide_mod.F90 (modified) (6 diffs)
-
libf/dyn3d/infotrac.F90 (modified) (4 diffs)
-
libf/dyn3d/iniacademic.F (modified) (8 diffs)
-
libf/dyn3d/iniconst.F (modified) (3 diffs)
-
libf/dyn3d/inidissip.F (modified) (3 diffs)
-
libf/dyn3d/inigeom.F (modified) (4 diffs)
-
libf/dyn3d/integrd.F (modified) (2 diffs)
-
libf/dyn3d/interp_horiz.F (modified) (2 diffs)
-
libf/dyn3d/interpre.F (modified) (2 diffs)
-
libf/dyn3d/juldate.F (modified) (1 diff)
-
libf/dyn3d/leapfrog.F (modified) (13 diffs)
-
libf/dyn3d/limit_netcdf.F90 (modified) (4 diffs)
-
libf/dyn3d/ord_coord.F (deleted)
-
libf/dyn3d/ord_coordm.F (deleted)
-
libf/dyn3d/ppm3d.F (modified) (13 diffs)
-
libf/dyn3d/ran1.F (modified) (3 diffs)
-
libf/dyn3d/sortvarc.F (modified) (3 diffs)
-
libf/dyn3d/sortvarc0.F (modified) (3 diffs)
-
libf/dyn3d/sw_case_williamson91_6.F (copied) (copied from LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/sw_case_williamson91_6.F)
-
libf/dyn3d/tourabs.F (modified) (1 diff)
-
libf/dyn3d/traceurpole.F (modified) (2 diffs)
-
libf/dyn3d/ugeostr.F (modified) (1 diff)
-
libf/dyn3d/write_paramLMDZ_dyn.h (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk
- Property svn:mergeinfo changed
-
LMDZ4/trunk/libf/dyn3d/adaptdt.F
r524 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 subroutine adaptdt(nadv,dtbon,n,pbaru, 5 5 c masse) 6 6 7 USE control_mod 7 8 IMPLICIT NONE 8 9 … … 16 17 #include "logic.h" 17 18 #include "temps.h" 18 #include "control.h"19 19 #include "ener.h" 20 20 #include "description.h" -
LMDZ4/trunk/libf/dyn3d/advtrac.F
r1279 r1403 16 16 c 17 17 USE infotrac 18 USE control_mod 19 18 20 19 21 IMPLICIT NONE … … 27 29 #include "logic.h" 28 30 #include "temps.h" 29 #include "control.h"30 31 #include "ener.h" 31 32 #include "description.h" … … 121 122 122 123 ! ... Flux de masse diaganostiques traceurs 123 flxw = wg / FLOAT(iapp_tracvl)124 flxw = wg / REAL(iapp_tracvl) 124 125 125 126 c test sur l'eventuelle creation de valeurs negatives de la masse -
LMDZ4/trunk/libf/dyn3d/bilan_dyn.F
r1279 r1403 423 423 Q_cum(:,:,:,iQ)=Q_cum(:,:,:,iQ)/masse_cum(:,:,:) 424 424 enddo 425 zz=1./ float(ncum)425 zz=1./REAL(ncum) 426 426 ps_cum=ps_cum*zz 427 427 masse_cum=masse_cum*zz -
LMDZ4/trunk/libf/dyn3d/caladvtrac.F
r1279 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 9 9 c 10 10 USE infotrac 11 USE control_mod 12 11 13 IMPLICIT NONE 12 14 c … … 24 26 #include "paramet.h" 25 27 #include "comconst.h" 26 #include "control.h"27 28 28 29 c Arguments: -
LMDZ4/trunk/libf/dyn3d/calfis.F
r1279 r1403 31 31 c ......... 32 32 USE infotrac 33 USE control_mod 34 33 35 34 36 IMPLICIT NONE … … 96 98 #include "comvert.h" 97 99 #include "comgeom2.h" 98 #include " control.h"100 #include "iniprint.h" 99 101 100 102 c Arguments : … … 149 151 REAL zdpsrf(ngridmx) 150 152 c 153 REAL zdufic(ngridmx,llm),zdvfic(ngridmx,llm) 154 REAL zdtfic(ngridmx,llm),zdqfic(ngridmx,llm,nqtot) 155 REAL jH_cur_split,zdt_split 156 LOGICAL debut_split,lafin_split 157 INTEGER isplit 158 151 159 REAL zsin(iim),zcos(iim),z1(iim) 152 160 REAL zsinbis(iim),zcosbis(iim),z1bis(iim) … … 181 189 debut = .TRUE. 182 190 IF (ngridmx.NE.2+(jjm-1)*iim) THEN 183 PRINT*,'STOP dans calfis' 184 PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim' 185 PRINT*,' ngridmx jjm iim ' 186 PRINT*,ngridmx,jjm,iim 191 write(lunout,*) 'STOP dans calfis' 192 write(lunout,*) 193 & 'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim' 194 write(lunout,*) ' ngridmx jjm iim ' 195 write(lunout,*) ngridmx,jjm,iim 187 196 STOP 188 197 ENDIF … … 308 317 CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,pphis,zphis) 309 318 DO l=1,llm 310 311 312 319 DO ig=1,ngridmx 320 zphi(ig,l)=zphi(ig,l)-zphis(ig) 321 ENDDO 313 322 ENDDO 314 323 … … 408 417 z1(i) =(rlonu(i)-rlonu(i-1))*pvcov(i,jjm,l)/cv(i,jjm) 409 418 z1bis(i)=(rlonu(i)-rlonu(i-1))*pdvcov(i,jjm,l)/cv(i,jjm) 410 419 ENDDO 411 420 412 421 DO i=1,iim … … 415 424 zsin(i) = SIN(rlonv(i))*z1(i) 416 425 zsinbis(i) = SIN(rlonv(i))*z1bis(i) 417 426 ENDDO 418 427 419 428 zufi(ngridmx,l) = SSUM(iim,zcos,1)/pi … … 443 452 if (planet_type=="earth") then 444 453 #ifdef CPP_EARTH 445 CALL physiq (ngridmx, 454 455 write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys 456 zdt_split=dtphys/nsplit_phys 457 zdufic(:,:)=0. 458 zdvfic(:,:)=0. 459 zdtfic(:,:)=0. 460 zdqfic(:,:,:)=0. 461 462 do isplit=1,nsplit_phys 463 464 jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys) 465 debut_split=debut.and.isplit==1 466 lafin_split=lafin.and.isplit==nsplit_phys 467 468 CALL physiq (ngridmx, 446 469 . llm, 447 . debut ,448 . lafin ,470 . debut_split, 471 . lafin_split, 449 472 . jD_cur, 450 . jH_cur ,451 . dtphys,473 . jH_cur_split, 474 . zdt_split, 452 475 . zplev, 453 476 . zplay, … … 469 492 . pducov, 470 493 . PVteta) 494 495 zufi(:,:)=zufi(:,:)+zdufi(:,:)*zdt_split 496 zvfi(:,:)=zvfi(:,:)+zdvfi(:,:)*zdt_split 497 ztfi(:,:)=ztfi(:,:)+zdtfi(:,:)*zdt_split 498 zqfi(:,:,:)=zqfi(:,:,:)+zdqfi(:,:,:)*zdt_split 499 500 zdufic(:,:)=zdufic(:,:)+zdufi(:,:) 501 zdvfic(:,:)=zdvfic(:,:)+zdvfi(:,:) 502 zdtfic(:,:)=zdtfic(:,:)+zdtfi(:,:) 503 zdqfic(:,:,:)=zdqfic(:,:,:)+zdqfi(:,:,:) 504 505 enddo 506 zdufi(:,:)=zdufic(:,:)/nsplit_phys 507 zdvfi(:,:)=zdvfic(:,:)/nsplit_phys 508 zdtfi(:,:)=zdtfic(:,:)/nsplit_phys 509 zdqfi(:,:,:)=zdqfic(:,:,:)/nsplit_phys 510 471 511 #endif 472 512 endif !of if (planet_type=="earth") -
LMDZ4/trunk/libf/dyn3d/ce0l.F90
r1323 r1403 14 14 ! masque is created in etat0, passed to limit to ensure consistancy. 15 15 !------------------------------------------------------------------------------- 16 USE control_mod 16 17 #ifdef CPP_EARTH 17 18 ! This prog. is designed to work for Earth … … 36 37 #include "indicesol.h" 37 38 #include "iniprint.h" 38 #include "control.h"39 39 #include "temps.h" 40 40 #include "logic.h" -
LMDZ4/trunk/libf/dyn3d/conf_gcm.F
r1323 r1403 6 6 SUBROUTINE conf_gcm( tapedef, etatinit, clesphy0 ) 7 7 c 8 USE control_mod 8 9 #ifdef CPP_IOIPSL 9 10 use IOIPSL … … 34 35 #include "dimensions.h" 35 36 #include "paramet.h" 36 #include "control.h"37 37 #include "logic.h" 38 38 #include "serre.h" … … 162 162 day_step = 240 163 163 CALL getin('day_step',day_step) 164 165 !Config Key = nsplit_phys 166 !Config Desc = nombre de pas par jour 167 !Config Def = 1 168 !Config Help = nombre de pas par jour (multiple de iperiod) ( 169 !Config ici pour dt = 1 min ) 170 nsplit_phys = 1 171 CALL getin('nsplit_phys',nsplit_phys) 164 172 165 173 !Config Key = iperiod … … 573 581 CALL getin('config_inca',config_inca) 574 582 575 576 583 !Config Key = ok_dynzon 577 584 !Config Desc = calcul et sortie des transports … … 581 588 ok_dynzon = .FALSE. 582 589 CALL getin('ok_dynzon',ok_dynzon) 590 591 !Config Key = ok_dyn_ins 592 !Config Desc = sorties instantanees dans la dynamique 593 !Config Def = n 594 !Config Help = 595 !Config 596 ok_dyn_ins = .FALSE. 597 CALL getin('ok_dyn_ins',ok_dyn_ins) 598 599 !Config Key = ok_dyn_ave 600 !Config Desc = sorties moyennes dans la dynamique 601 !Config Def = n 602 !Config Help = 603 !Config 604 ok_dyn_ave = .FALSE. 605 CALL getin('ok_dyn_ave',ok_dyn_ave) 606 583 607 584 608 write(lunout,*)' #########################################' … … 620 644 write(lunout,*)' config_inca = ', config_inca 621 645 write(lunout,*)' ok_dynzon = ', ok_dynzon 646 write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins 647 write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave 622 648 623 649 RETURN … … 746 772 747 773 !Config Key = ok_dynzon 748 !Config Desc = calcul et sortie des transports774 !Config Desc = sortie des transports zonaux dans la dynamique 749 775 !Config Def = n 750 !Config Help = Permet de mettre en route le calcul des transports776 !Config Help = 751 777 !Config 752 778 ok_dynzon = .FALSE. 753 779 CALL getin('ok_dynzon',ok_dynzon) 780 781 !Config Key = ok_dyn_ins 782 !Config Desc = sorties instantanees dans la dynamique 783 !Config Def = n 784 !Config Help = 785 !Config 786 ok_dyn_ins = .FALSE. 787 CALL getin('ok_dyn_ins',ok_dyn_ins) 788 789 !Config Key = ok_dyn_ave 790 !Config Desc = sorties moyennes dans la dynamique 791 !Config Def = n 792 !Config Help = 793 !Config 794 ok_dyn_ave = .FALSE. 795 CALL getin('ok_dyn_ave',ok_dyn_ave) 754 796 755 797 !Config key = ok_strato … … 824 866 write(lunout,*)' config_inca = ', config_inca 825 867 write(lunout,*)' ok_dynzon = ', ok_dynzon 868 write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins 869 write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave 826 870 write(lunout,*)' ok_strato = ', ok_strato 827 871 write(lunout,*)' ok_gradsfile = ', ok_gradsfile -
LMDZ4/trunk/libf/dyn3d/defrun.F
r956 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 9 8 10 IMPLICIT NONE 9 11 c----------------------------------------------------------------------- … … 28 30 #include "dimensions.h" 29 31 #include "paramet.h" 30 #include "control.h"31 32 #include "logic.h" 32 33 #include "serre.h" … … 239 240 clesphy0(i) = 0. 240 241 ENDDO 241 clesphy0(1) = FLOAT( iflag_con )242 clesphy0(2) = FLOAT( nbapp_rad )242 clesphy0(1) = REAL( iflag_con ) 243 clesphy0(2) = REAL( nbapp_rad ) 243 244 244 245 IF( cycle_diurne ) clesphy0(3) = 1. -
LMDZ4/trunk/libf/dyn3d/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/dyn3d/dynetat0.F
r1146 r1403 1 1 ! 2 ! $ Header$2 ! $Id $ 3 3 ! 4 4 SUBROUTINE dynetat0(fichnom,vcov,ucov, … … 34 34 #include "serre.h" 35 35 #include "logic.h" 36 #include "iniprint.h" 36 37 37 38 c Arguments: … … 58 59 ierr = NF_OPEN (fichnom, NF_NOWRITE,nid) 59 60 IF (ierr.NE.NF_NOERR) THEN 60 write( 6,*)'Pb d''ouverture du fichier start.nc'61 write( 6,*)' ierr = ', ierr61 write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc' 62 write(lunout,*)' ierr = ', ierr 62 63 CALL ABORT 63 64 ENDIF … … 66 67 ierr = NF_INQ_VARID (nid, "controle", nvarid) 67 68 IF (ierr .NE. NF_NOERR) THEN 68 PRINT*,"dynetat0: Le champ <controle> est absent"69 write(lunout,*)"dynetat0: Le champ <controle> est absent" 69 70 CALL abort 70 71 ENDIF … … 75 76 #endif 76 77 IF (ierr .NE. NF_NOERR) THEN 77 PRINT*,"dynetat0: Lecture echoue pour <controle>"78 write(lunout,*)"dynetat0: Lecture echoue pour <controle>" 78 79 CALL abort 79 80 ENDIF … … 121 122 c 122 123 c 123 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 124 126 125 127 IF( im.ne.iim ) THEN … … 136 138 ierr = NF_INQ_VARID (nid, "rlonu", nvarid) 137 139 IF (ierr .NE. NF_NOERR) THEN 138 PRINT*,"dynetat0: Le champ <rlonu> est absent"140 write(lunout,*)"dynetat0: Le champ <rlonu> est absent" 139 141 CALL abort 140 142 ENDIF … … 145 147 #endif 146 148 IF (ierr .NE. NF_NOERR) THEN 147 PRINT*,"dynetat0: Lecture echouee pour <rlonu>"149 write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>" 148 150 CALL abort 149 151 ENDIF … … 151 153 ierr = NF_INQ_VARID (nid, "rlatu", nvarid) 152 154 IF (ierr .NE. NF_NOERR) THEN 153 PRINT*,"dynetat0: Le champ <rlatu> est absent"155 write(lunout,*)"dynetat0: Le champ <rlatu> est absent" 154 156 CALL abort 155 157 ENDIF … … 160 162 #endif 161 163 IF (ierr .NE. NF_NOERR) THEN 162 PRINT*,"dynetat0: Lecture echouee pour <rlatu>"164 write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>" 163 165 CALL abort 164 166 ENDIF … … 166 168 ierr = NF_INQ_VARID (nid, "rlonv", nvarid) 167 169 IF (ierr .NE. NF_NOERR) THEN 168 PRINT*,"dynetat0: Le champ <rlonv> est absent"170 write(lunout,*)"dynetat0: Le champ <rlonv> est absent" 169 171 CALL abort 170 172 ENDIF … … 175 177 #endif 176 178 IF (ierr .NE. NF_NOERR) THEN 177 PRINT*,"dynetat0: Lecture echouee pour <rlonv>"179 write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>" 178 180 CALL abort 179 181 ENDIF … … 181 183 ierr = NF_INQ_VARID (nid, "rlatv", nvarid) 182 184 IF (ierr .NE. NF_NOERR) THEN 183 PRINT*,"dynetat0: Le champ <rlatv> est absent"185 write(lunout,*)"dynetat0: Le champ <rlatv> est absent" 184 186 CALL abort 185 187 ENDIF … … 190 192 #endif 191 193 IF (ierr .NE. NF_NOERR) THEN 192 PRINT*,"dynetat0: Lecture echouee pour rlatv"194 write(lunout,*)"dynetat0: Lecture echouee pour rlatv" 193 195 CALL abort 194 196 ENDIF … … 196 198 ierr = NF_INQ_VARID (nid, "cu", nvarid) 197 199 IF (ierr .NE. NF_NOERR) THEN 198 PRINT*,"dynetat0: Le champ <cu> est absent"200 write(lunout,*)"dynetat0: Le champ <cu> est absent" 199 201 CALL abort 200 202 ENDIF … … 205 207 #endif 206 208 IF (ierr .NE. NF_NOERR) THEN 207 PRINT*,"dynetat0: Lecture echouee pour <cu>"209 write(lunout,*)"dynetat0: Lecture echouee pour <cu>" 208 210 CALL abort 209 211 ENDIF … … 211 213 ierr = NF_INQ_VARID (nid, "cv", nvarid) 212 214 IF (ierr .NE. NF_NOERR) THEN 213 PRINT*,"dynetat0: Le champ <cv> est absent"215 write(lunout,*)"dynetat0: Le champ <cv> est absent" 214 216 CALL abort 215 217 ENDIF … … 220 222 #endif 221 223 IF (ierr .NE. NF_NOERR) THEN 222 PRINT*,"dynetat0: Lecture echouee pour <cv>"224 write(lunout,*)"dynetat0: Lecture echouee pour <cv>" 223 225 CALL abort 224 226 ENDIF … … 226 228 ierr = NF_INQ_VARID (nid, "aire", nvarid) 227 229 IF (ierr .NE. NF_NOERR) THEN 228 PRINT*,"dynetat0: Le champ <aire> est absent"230 write(lunout,*)"dynetat0: Le champ <aire> est absent" 229 231 CALL abort 230 232 ENDIF … … 235 237 #endif 236 238 IF (ierr .NE. NF_NOERR) THEN 237 PRINT*,"dynetat0: Lecture echouee pour <aire>"239 write(lunout,*)"dynetat0: Lecture echouee pour <aire>" 238 240 CALL abort 239 241 ENDIF … … 241 243 ierr = NF_INQ_VARID (nid, "phisinit", nvarid) 242 244 IF (ierr .NE. NF_NOERR) THEN 243 PRINT*,"dynetat0: Le champ <phisinit> est absent"245 write(lunout,*)"dynetat0: Le champ <phisinit> est absent" 244 246 CALL abort 245 247 ENDIF … … 250 252 #endif 251 253 IF (ierr .NE. NF_NOERR) THEN 252 PRINT*,"dynetat0: Lecture echouee pour <phisinit>"254 write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>" 253 255 CALL abort 254 256 ENDIF … … 256 258 ierr = NF_INQ_VARID (nid, "temps", nvarid) 257 259 IF (ierr .NE. NF_NOERR) THEN 258 PRINT*,"dynetat0: Le champ <temps> est absent"260 write(lunout,*)"dynetat0: Le champ <temps> est absent" 259 261 CALL abort 260 262 ENDIF … … 265 267 #endif 266 268 IF (ierr .NE. NF_NOERR) THEN 267 PRINT*,"dynetat0: Lecture echouee <temps>"269 write(lunout,*)"dynetat0: Lecture echouee <temps>" 268 270 CALL abort 269 271 ENDIF … … 271 273 ierr = NF_INQ_VARID (nid, "ucov", nvarid) 272 274 IF (ierr .NE. NF_NOERR) THEN 273 PRINT*,"dynetat0: Le champ <ucov> est absent"275 write(lunout,*)"dynetat0: Le champ <ucov> est absent" 274 276 CALL abort 275 277 ENDIF … … 280 282 #endif 281 283 IF (ierr .NE. NF_NOERR) THEN 282 PRINT*,"dynetat0: Lecture echouee pour <ucov>"284 write(lunout,*)"dynetat0: Lecture echouee pour <ucov>" 283 285 CALL abort 284 286 ENDIF … … 286 288 ierr = NF_INQ_VARID (nid, "vcov", nvarid) 287 289 IF (ierr .NE. NF_NOERR) THEN 288 PRINT*,"dynetat0: Le champ <vcov> est absent"290 write(lunout,*)"dynetat0: Le champ <vcov> est absent" 289 291 CALL abort 290 292 ENDIF … … 295 297 #endif 296 298 IF (ierr .NE. NF_NOERR) THEN 297 PRINT*,"dynetat0: Lecture echouee pour <vcov>"299 write(lunout,*)"dynetat0: Lecture echouee pour <vcov>" 298 300 CALL abort 299 301 ENDIF … … 301 303 ierr = NF_INQ_VARID (nid, "teta", nvarid) 302 304 IF (ierr .NE. NF_NOERR) THEN 303 PRINT*,"dynetat0: Le champ <teta> est absent"305 write(lunout,*)"dynetat0: Le champ <teta> est absent" 304 306 CALL abort 305 307 ENDIF … … 310 312 #endif 311 313 IF (ierr .NE. NF_NOERR) THEN 312 PRINT*,"dynetat0: Lecture echouee pour <teta>"314 write(lunout,*)"dynetat0: Lecture echouee pour <teta>" 313 315 CALL abort 314 316 ENDIF … … 319 321 ierr = NF_INQ_VARID (nid, tname(iq), nvarid) 320 322 IF (ierr .NE. NF_NOERR) THEN 321 PRINT*, "dynetat0: Le champ <"//tname(iq)//"> est absent" 322 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" 323 326 q(:,:,iq)=0. 324 327 ELSE … … 329 332 #endif 330 333 IF (ierr .NE. NF_NOERR) THEN 331 PRINT*,"dynetat0: Lecture echouee pour "//tname(iq)332 334 write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq) 335 CALL abort 333 336 ENDIF 334 337 ENDIF … … 338 341 ierr = NF_INQ_VARID (nid, "masse", nvarid) 339 342 IF (ierr .NE. NF_NOERR) THEN 340 PRINT*,"dynetat0: Le champ <masse> est absent"343 write(lunout,*)"dynetat0: Le champ <masse> est absent" 341 344 CALL abort 342 345 ENDIF … … 347 350 #endif 348 351 IF (ierr .NE. NF_NOERR) THEN 349 PRINT*,"dynetat0: Lecture echouee pour <masse>"352 write(lunout,*)"dynetat0: Lecture echouee pour <masse>" 350 353 CALL abort 351 354 ENDIF … … 353 356 ierr = NF_INQ_VARID (nid, "ps", nvarid) 354 357 IF (ierr .NE. NF_NOERR) THEN 355 PRINT*,"dynetat0: Le champ <ps> est absent"358 write(lunout,*)"dynetat0: Le champ <ps> est absent" 356 359 CALL abort 357 360 ENDIF … … 362 365 #endif 363 366 IF (ierr .NE. NF_NOERR) THEN 364 PRINT*,"dynetat0: Lecture echouee pour <ps>"367 write(lunout,*)"dynetat0: Lecture echouee pour <ps>" 365 368 CALL abort 366 369 ENDIF -
LMDZ4/trunk/libf/dyn3d/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/dyn3d/etat0_netcdf.F90
r1328 r1403 11 11 ! Note: This routine is designed to work for Earth 12 12 !------------------------------------------------------------------------------- 13 USE control_mod 13 14 #ifdef CPP_EARTH 14 15 USE startvar … … 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/dyn3d/exner_hyb.F
r524 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/dyn3d/extrapol.F
r524 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/dyn3d/fluxstokenc.F
r1279 r1403 4 4 SUBROUTINE fluxstokenc(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 … … 114 114 DO l=1,llm 115 115 DO ij = 1,ip1jmp1 116 pbaruc(ij,l) = pbaruc(ij,l)/ float(istdyn)117 tetac(ij,l) = tetac(ij,l)/ float(istdyn)118 phic(ij,l) = phic(ij,l)/ float(istdyn)116 pbaruc(ij,l) = pbaruc(ij,l)/REAL(istdyn) 117 tetac(ij,l) = tetac(ij,l)/REAL(istdyn) 118 phic(ij,l) = phic(ij,l)/REAL(istdyn) 119 119 ENDDO 120 120 DO ij = 1,ip1jm 121 pbarvc(ij,l) = pbarvc(ij,l)/ float(istdyn)121 pbarvc(ij,l) = pbarvc(ij,l)/REAL(istdyn) 122 122 ENDDO 123 123 ENDDO … … 141 141 142 142 iadvtr=0 143 Print*,'ITAU auqel on stoke les fluxmasses',itau143 write(lunout,*)'ITAU auquel on stoke les fluxmasses',itau 144 144 145 145 call histwrite(fluxid, 'masse', itau, massem, … … 167 167 #else 168 168 write(lunout,*) 169 & 'fluxstokenc: Needs Earth physics (and ioipsl)to function'169 & 'fluxstokenc: Needs IOIPSL to function' 170 170 #endif 171 ! of #ifdef CPP_ EARTH171 ! of #ifdef CPP_IOIPSL 172 172 RETURN 173 173 END -
LMDZ4/trunk/libf/dyn3d/friction.F
r524 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c======================================================================= 5 5 SUBROUTINE friction(ucov,vcov,pdt) 6 7 USE control_mod 8 6 9 IMPLICIT NONE 7 10 … … 21 24 #include "paramet.h" 22 25 #include "comgeom2.h" 23 #include "control.h"24 26 #include "comconst.h" 25 27 -
LMDZ4/trunk/libf/dyn3d/fxhyp.F
r1279 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/dyn3d/fxy.F
r524 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/dyn3d/fxysinus.F
r524 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/dyn3d/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/dyn3d/gcm.F
r1315 r1403 15 15 USE filtreg_mod 16 16 USE infotrac 17 USE control_mod 17 18 18 19 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 68 69 #include "logic.h" 69 70 #include "temps.h" 70 #include "control.h"71 !!!!!!!!!!!#include "control.h" 71 72 #include "ener.h" 72 73 #include "description.h" 73 74 #include "serre.h" 74 #include "com_io_dyn.h"75 !#include "com_io_dyn.h" 75 76 #include "iniprint.h" 76 77 #include "tracstoke.h" 78 #ifdef INCA 79 ! Only INCA needs these informations (from the Earth's physics) 77 80 #include "indicesol.h" 78 81 #endif 79 82 INTEGER longcles 80 83 PARAMETER ( longcles = 20 ) … … 181 184 if (planet_type.eq."earth") then 182 185 #ifdef CPP_EARTH 183 CALL Init_Phys_lmdz(iim,jjp1,llm,1,( jjm-1)*iim+2)186 CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/)) 184 187 call InitComgeomphy 185 188 #endif … … 241 244 if (read_start) then 242 245 ! we still need to run iniacademic to initialize some 243 ! constants & fields, if we run the 'newtonian' case:244 if (iflag_phys. eq.2) then246 ! constants & fields, if we run the 'newtonian' or 'SW' cases: 247 if (iflag_phys.ne.1) then 245 248 CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0) 246 249 endif 247 !#ifdef CPP_IOIPSL 250 248 251 if (planet_type.eq."earth") then 249 252 #ifdef CPP_EARTH 250 253 ! Load an Earth-format start file 251 254 CALL dynetat0("start.nc",vcov,ucov, 252 . teta,q,masse,ps,phis, time_0) 255 & teta,q,masse,ps,phis, time_0) 256 #else 257 ! SW model also has Earth-format start files 258 ! (but can be used without the CPP_EARTH directive) 259 if (iflag_phys.eq.0) then 260 CALL dynetat0("start.nc",vcov,ucov, 261 & teta,q,masse,ps,phis, time_0) 262 endif 253 263 #endif 254 264 endif ! of if (planet_type.eq."earth") 265 255 266 c write(73,*) 'ucov',ucov 256 267 c write(74,*) 'vcov',vcov … … 294 305 ENDIF 295 306 296 zdtvr = daysec/ FLOAT(day_step)307 zdtvr = daysec/REAL(day_step) 297 308 IF(dtvr.NE.zdtvr) THEN 298 309 WRITE(lunout,*) … … 303 314 C on remet le calendrier à zero si demande 304 315 c 305 if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then 316 IF (raz_date == 1) THEN 317 annee_ref = anneeref 318 day_ref = dayref 319 day_ini = dayref 320 itau_dyn = 0 321 itau_phy = 0 322 time_0 = 0. 323 write(lunout,*) 324 . 'GCM: On reinitialise a la date lue dans gcm.def' 325 ELSE IF (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN 306 326 write(lunout,*) 307 327 . 'GCM: Attention les dates initiales lues dans le fichier' … … 309 329 . ' restart ne correspondent pas a celles lues dans ' 310 330 write(lunout,*)' gcm.def' 311 write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref 312 write(lunout,*)' day_ref=',day_ref," dayref=",dayref 313 if (raz_date .ne. 1) then 314 write(lunout,*) 315 . 'GCM: On garde les dates du fichier restart' 316 else 317 annee_ref = anneeref 318 day_ref = dayref 319 day_ini = dayref 320 itau_dyn = 0 321 itau_phy = 0 322 time_0 = 0. 323 write(lunout,*) 324 . 'GCM: On reinitialise a la date lue dans gcm.def' 325 endif 326 ELSE 327 raz_date = 0 328 endif 331 write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref 332 write(lunout,*)' day_ref=',day_ref," dayref=",dayref 333 write(lunout,*)' Pas de remise a zero' 334 ENDIF 335 336 c if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then 337 c write(lunout,*) 338 c . 'GCM: Attention les dates initiales lues dans le fichier' 339 c write(lunout,*) 340 c . ' restart ne correspondent pas a celles lues dans ' 341 c write(lunout,*)' gcm.def' 342 c write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref 343 c write(lunout,*)' day_ref=',day_ref," dayref=",dayref 344 c if (raz_date .ne. 1) then 345 c write(lunout,*) 346 c . 'GCM: On garde les dates du fichier restart' 347 c else 348 c annee_ref = anneeref 349 c day_ref = dayref 350 c day_ini = dayref 351 c itau_dyn = 0 352 c itau_phy = 0 353 c time_0 = 0. 354 c write(lunout,*) 355 c . 'GCM: On reinitialise a la date lue dans gcm.def' 356 c endif 357 c ELSE 358 c raz_date = 0 359 c endif 329 360 330 361 #ifdef CPP_IOIPSL … … 355 386 nbetatmoy = nday / periodav + 1 356 387 388 if (iflag_phys.eq.1) then 389 ! these initialisations have already been done (via iniacademic) 390 ! if running in SW or Newtonian mode 357 391 c----------------------------------------------------------------------- 358 392 c Initialisation des constantes dynamiques : 359 393 c ------------------------------------------ 360 dtvr = zdtvr361 CALL iniconst394 dtvr = zdtvr 395 CALL iniconst 362 396 363 397 c----------------------------------------------------------------------- 364 398 c Initialisation de la geometrie : 365 399 c -------------------------------- 366 CALL inigeom400 CALL inigeom 367 401 368 402 c----------------------------------------------------------------------- 369 403 c Initialisation du filtre : 370 404 c -------------------------- 371 CALL inifilr 405 CALL inifilr 406 endif ! of if (iflag_phys.eq.1) 372 407 c 373 408 c----------------------------------------------------------------------- … … 405 440 if (planet_type.eq."earth") then 406 441 #ifdef CPP_EARTH 407 CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys ,442 CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys , 408 443 , latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp ) 409 444 #endif … … 440 475 441 476 #ifdef CPP_IOIPSL 442 if ( 1.eq.1) then443 477 time_step = zdtvr 444 t_ops = iecri * daysec 445 t_wrt = iecri * daysec 446 ! CALL inithist(dynhist_file,day_ref,annee_ref,time_step, 447 ! . t_ops, t_wrt, histid, histvid) 448 449 ! IF (ok_dynzon) THEN 450 ! t_ops = iperiod * time_step 451 ! t_wrt = periodav * daysec 452 ! CALL initdynav(dynhistave_file,day_ref,annee_ref,time_step, 453 ! . t_ops, t_wrt, histaveid) 454 ! END IF 478 if (ok_dyn_ins) then 479 ! initialize output file for instantaneous outputs 480 ! t_ops = iecri * daysec ! do operations every t_ops 481 t_ops =((1.0*iecri)/day_step) * daysec 482 t_wrt = daysec ! iecri * daysec ! write output every t_wrt 483 CALL inithist(day_ref,annee_ref,time_step, 484 & t_ops,t_wrt) 485 endif 486 487 IF (ok_dyn_ave) THEN 488 ! initialize output file for averaged outputs 489 t_ops = iperiod * time_step ! do operations every t_ops 490 t_wrt = periodav * daysec ! write output every t_wrt 491 CALL initdynav(day_ref,annee_ref,time_step, 492 & t_ops,t_wrt) 493 END IF 455 494 dtav = iperiod*dtvr/daysec 456 endif457 458 459 495 #endif 460 496 ! #endif of #ifdef CPP_IOIPSL -
LMDZ4/trunk/libf/dyn3d/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/dyn3d/grid_noro.F
r773 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/dyn3d/grilles_gcm_netcdf.F
r636 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/dyn3d/guide_mod.F90
r1304 r1403 62 62 SUBROUTINE guide_init 63 63 64 USE control_mod 65 64 66 IMPLICIT NONE 65 67 … … 67 69 INCLUDE "paramet.h" 68 70 INCLUDE "netcdf.inc" 69 INCLUDE "control.h"70 71 71 72 INTEGER :: error,ncidpl,rid,rcod … … 269 270 !======================================================================= 270 271 SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps) 272 273 USE control_mod 271 274 272 275 IMPLICIT NONE … … 274 277 INCLUDE "dimensions.h" 275 278 INCLUDE "paramet.h" 276 INCLUDE "control.h"277 279 INCLUDE "comconst.h" 278 280 INCLUDE "comvert.h" … … 354 356 dday_step=real(day_step) 355 357 IF (iguide_read.LT.0) THEN 356 tau=ditau/dday_step/ FLOAT(iguide_read)358 tau=ditau/dday_step/REAL(iguide_read) 357 359 ELSE 358 tau= FLOAT(iguide_read)*ditau/dday_step360 tau=REAL(iguide_read)*ditau/dday_step 359 361 ENDIF 360 362 reste=tau-AINT(tau) … … 541 543 ENDDO 542 544 ENDDO 543 fieldm(:,l)=fieldm(:,l)/ FLOAT(imax(typ)-imin(typ)+1)545 fieldm(:,l)=fieldm(:,l)/REAL(imax(typ)-imin(typ)+1) 544 546 ! Compute forcing 545 547 DO j=1,hsize -
LMDZ4/trunk/libf/dyn3d/infotrac.F90
r1279 r1403 31 31 32 32 SUBROUTINE infotrac_init 33 34 USE control_mod 35 33 36 IMPLICIT NONE 34 37 !======================================================================= … … 49 52 50 53 INCLUDE "dimensions.h" 51 INCLUDE "control.h"52 54 INCLUDE "iniprint.h" 53 55 … … 217 219 new_iq=new_iq+10 ! 9 tracers added 218 220 ELSE 219 WRITE(lunout,*) 'This choice of advection schema is not available' 221 WRITE(lunout,*) 'This choice of advection schema is not available',iq,hadv(iq),vadv(iq) 220 222 CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1) 221 223 END IF … … 258 260 iadv(new_iq)=11 259 261 ELSE 260 WRITE(lunout,*)'This choice of advection schema is not available' 262 WRITE(lunout,*)'This choice of advection schema is not available',iq,hadv(iq),vadv(iq) 261 263 CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1) 262 264 END IF -
LMDZ4/trunk/libf/dyn3d/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: … … 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/dyn3d/iniconst.F
r524 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/dyn3d/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/dyn3d/inigeom.F
r524 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/dyn3d/integrd.F
r1279 r1403 5 5 $ ( nq,vcovm1,ucovm1,tetam1,psm1,massem1, 6 6 $ dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis,finvmaold ) 7 8 USE control_mod 7 9 8 10 IMPLICIT NONE … … 32 34 #include "temps.h" 33 35 #include "serre.h" 34 #include "control.h"35 36 36 37 c Arguments: -
LMDZ4/trunk/libf/dyn3d/interp_horiz.F
r616 r1403 1 1 c 2 c $ Header$2 c $Id$ 3 3 c 4 4 subroutine interp_horiz (varo,varn,imo,jmo,imn,jmn,lm, … … 101 101 end do 102 102 do ii =1, imn+1 103 varn(ii,1,l) = totn/ float(imn+1)104 varn(ii,jmn+1,l) = tots/ float(imn+1)103 varn(ii,1,l) = totn/REAL(imn+1) 104 varn(ii,jmn+1,l) = tots/REAL(imn+1) 105 105 end do 106 106 end do -
LMDZ4/trunk/libf/dyn3d/interpre.F
r524 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 subroutine interpre(q,qppm,w,fluxwppm,masse, 5 5 s apppm,bpppm,massebx,masseby,pbaru,pbarv, 6 6 s unatppm,vnatppm,psppm) 7 8 USE control_mod 7 9 8 10 implicit none … … 17 19 #include "logic.h" 18 20 #include "temps.h" 19 #include "control.h"20 21 #include "ener.h" 21 22 #include "description.h" -
LMDZ4/trunk/libf/dyn3d/juldate.F
r524 r1403 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 subroutine juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec) -
LMDZ4/trunk/libf/dyn3d/leapfrog.F
r1286 r1403 15 15 USE guide_mod, ONLY : guide_main 16 16 USE write_field 17 USE control_mod 17 18 IMPLICIT NONE 18 19 … … 56 57 #include "logic.h" 57 58 #include "temps.h" 58 #include "control.h"59 59 #include "ener.h" 60 60 #include "description.h" 61 61 #include "serre.h" 62 #include "com_io_dyn.h"62 !#include "com_io_dyn.h" 63 63 #include "iniprint.h" 64 64 #include "academic.h" … … 197 197 198 198 itau = 0 199 c $$$iday = day_ini+itau/day_step200 c $$$ time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0201 c $$$IF(time.GT.1.) THEN202 c $$$time = time-1.203 c $$$iday = iday+1204 c $$$ENDIF199 c iday = day_ini+itau/day_step 200 c time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 201 c IF(time.GT.1.) THEN 202 c time = time-1. 203 c iday = iday+1 204 c ENDIF 205 205 206 206 … … 276 276 277 277 IF( purmats ) THEN 278 ! Purely Matsuno time stepping 278 279 IF( MOD(itau,iconser) .EQ.0.AND. forward ) conser = .TRUE. 279 280 IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE. … … 281 282 s .and. iflag_phys.EQ.1 ) apphys = .TRUE. 282 283 ELSE 284 ! Leapfrog/Matsuno time stepping 283 285 IF( MOD(itau ,iconser) .EQ. 0 ) conser = .TRUE. 284 286 IF( MOD(itau+1,idissip) .EQ. 0 ) apdiss = .TRUE. 285 287 IF( MOD(itau+1,iphysiq).EQ.0.AND.iflag_phys.EQ.1) apphys=.TRUE. 286 288 END IF 289 290 ! Ehouarn: for Shallow Water case (ie: 1 vertical layer), 291 ! supress dissipation step 292 if (llm.eq.1) then 293 apdiss=.false. 294 endif 287 295 288 296 c----------------------------------------------------------------------- … … 522 530 IF(forward. OR. leapf) THEN 523 531 itau= itau + 1 524 c $$$iday= day_ini+itau/day_step525 c $$$ time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0526 c $$$IF(time.GT.1.) THEN527 c $$$time = time-1.528 c $$$iday = iday+1529 c $$$ENDIF532 c iday= day_ini+itau/day_step 533 c time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 534 c IF(time.GT.1.) THEN 535 c time = time-1. 536 c iday = iday+1 537 c ENDIF 530 538 ENDIF 531 539 … … 559 567 IF (ok_dynzon) THEN 560 568 #ifdef CPP_IOIPSL 561 ! CALL writedynav(histaveid, itau,vcov , 562 ! , ucov,teta,pk,phi,q,masse,ps,phis) 563 CALL bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav, 564 , ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q) 569 CALL bilan_dyn(2,dtvr*iperiod,dtvr*day_step*periodav, 570 & ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q) 565 571 #endif 566 572 END IF 567 568 ENDIF 573 IF (ok_dyn_ave) THEN 574 #ifdef CPP_IOIPSL 575 CALL writedynav(itau,vcov, 576 & ucov,teta,pk,phi,q,masse,ps,phis) 577 #endif 578 ENDIF 579 580 ENDIF ! of IF((MOD(itau,iperiod).EQ.0).OR.(itau.EQ.itaufin)) 569 581 570 582 c----------------------------------------------------------------------- … … 572 584 c ------------------------------ 573 585 574 IF( MOD(itau,iecri 575 c IF( MOD(itau,iecri*day_step).EQ.0) THEN 576 586 IF( MOD(itau,iecri).EQ.0) THEN 587 ! Ehouarn: output only during LF or Backward Matsuno 588 if (leapf.or.(.not.leapf.and.(.not.forward))) then 577 589 nbetat = nbetatdem 578 590 CALL geopot(ip1jmp1,teta,pk,pks,phis,phi) … … 583 595 enddo 584 596 #ifdef CPP_IOIPSL 585 c CALL writehist(histid,histvid,itau,vcov, 586 c & ucov,teta,phi,q,masse,ps,phis) 597 if (ok_dyn_ins) then 598 ! write(lunout,*) "leapfrog: call writehist, itau=",itau 599 CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis) 600 ! call WriteField('ucov',reshape(ucov,(/iip1,jmp1,llm/))) 601 ! call WriteField('vcov',reshape(vcov,(/iip1,jjm,llm/))) 602 ! call WriteField('teta',reshape(teta,(/iip1,jmp1,llm/))) 603 ! call WriteField('ps',reshape(ps,(/iip1,jmp1/))) 604 ! call WriteField('masse',reshape(masse,(/iip1,jmp1,llm/))) 605 endif ! of if (ok_dyn_ins) 587 606 #endif 588 607 ! For some Grads outputs of fields 589 if (output_grads_dyn) then608 if (output_grads_dyn) then 590 609 #include "write_grads_dyn.h" 591 endif592 610 endif 611 endif ! of if (leapf.or.(.not.leapf.and.(.not.forward))) 593 612 ENDIF ! of IF(MOD(itau,iecri).EQ.0) 594 613 … … 645 664 646 665 itau = itau + 1 647 c $$$iday = day_ini+itau/day_step648 c $$$ time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0649 c $$$650 c $$$IF(time.GT.1.) THEN651 c $$$time = time-1.652 c $$$iday = iday+1653 c $$$ENDIF666 c iday = day_ini+itau/day_step 667 c time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 668 c 669 c IF(time.GT.1.) THEN 670 c time = time-1. 671 c iday = iday+1 672 c ENDIF 654 673 655 674 forward = .FALSE. … … 660 679 GO TO 2 661 680 662 ELSE ! of IF(forward) 681 ELSE ! of IF(forward) i.e. backward step 663 682 664 683 IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN … … 671 690 IF (ok_dynzon) THEN 672 691 #ifdef CPP_IOIPSL 673 ! CALL writedynav(histaveid, itau,vcov , 674 ! , ucov,teta,pk,phi,q,masse,ps,phis) 675 CALL bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav, 676 , ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q) 677 #endif 678 END IF 692 CALL bilan_dyn(2,dtvr*iperiod,dtvr*day_step*periodav, 693 & ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q) 694 #endif 695 ENDIF 696 IF (ok_dyn_ave) THEN 697 #ifdef CPP_IOIPSL 698 CALL writedynav(itau,vcov, 699 & ucov,teta,pk,phi,q,masse,ps,phis) 700 #endif 701 ENDIF 679 702 680 703 ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) … … 690 713 enddo 691 714 #ifdef CPP_IOIPSL 692 c CALL writehist( histid, histvid, itau,vcov , 693 c & ucov,teta,phi,q,masse,ps,phis) 715 if (ok_dyn_ins) then 716 ! write(lunout,*) "leapfrog: call writehist (b)", 717 ! & itau,iecri 718 CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis) 719 endif ! of if (ok_dyn_ins) 694 720 #endif 695 721 ! For some Grads outputs -
LMDZ4/trunk/libf/dyn3d/limit_netcdf.F90
r1328 r1403 20 20 ! * 12/2009: D. Cugnet (f77->f90, calendars, files from coupled runs) 21 21 !------------------------------------------------------------------------------- 22 USE control_mod 22 23 #ifdef CPP_EARTH 23 24 USE dimphy … … 27 28 NF90_DEF_DIM, NF90_DEF_VAR, NF90_PUT_VAR, NF90_PUT_ATT, & 28 29 NF90_NOERR, NF90_NOWRITE, NF90_DOUBLE, NF90_GLOBAL, & 29 NF90_CLOBBER, NF90_ENDDEF, NF90_UNLIMITED 30 NF90_CLOBBER, NF90_ENDDEF, NF90_UNLIMITED, NF90_FLOAT 30 31 USE inter_barxy_m, only: inter_barxy 31 32 #endif … … 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/dyn3d/ppm3d.F
r695 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/dyn3d/ran1.F
r524 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/dyn3d/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/dyn3d/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/dyn3d/tourabs.F
r644 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/dyn3d/traceurpole.F
r524 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/dyn3d/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 -
LMDZ4/trunk/libf/dyn3d/write_paramLMDZ_dyn.h
r1279 r1403 7 7 itau_w=itau_dyn+itau 8 8 c 9 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(prt_level)9 zx_tmp_2d(1:iip1,1:jjp1)=REAL(prt_level) 10 10 CALL histwrite(nid_ctesGCM, "prt_level", itau_w, 11 11 . zx_tmp_2d,iip1*jjp1,ndex2d) 12 12 c 13 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(dayref)13 zx_tmp_2d(1:iip1,1:jjp1)=REAL(dayref) 14 14 CALL histwrite(nid_ctesGCM, "dayref", itau_w, 15 15 . zx_tmp_2d,iip1*jjp1,ndex2d) 16 16 c 17 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(anneeref)17 zx_tmp_2d(1:iip1,1:jjp1)=REAL(anneeref) 18 18 CALL histwrite(nid_ctesGCM, "anneeref", itau_w, 19 19 . zx_tmp_2d,iip1*jjp1,ndex2d) 20 20 c 21 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(raz_date)21 zx_tmp_2d(1:iip1,1:jjp1)=REAL(raz_date) 22 22 CALL histwrite(nid_ctesGCM, "raz_date", itau_w, 23 23 . zx_tmp_2d,iip1*jjp1,ndex2d) 24 24 c 25 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(nday)25 zx_tmp_2d(1:iip1,1:jjp1)=REAL(nday) 26 26 CALL histwrite(nid_ctesGCM, "nday", itau_w, 27 27 . zx_tmp_2d,iip1*jjp1,ndex2d) 28 28 c 29 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(day_step)29 zx_tmp_2d(1:iip1,1:jjp1)=REAL(day_step) 30 30 CALL histwrite(nid_ctesGCM, "day_step", itau_w, 31 31 . zx_tmp_2d,iip1*jjp1,ndex2d) 32 32 c 33 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(iperiod)33 zx_tmp_2d(1:iip1,1:jjp1)=REAL(iperiod) 34 34 CALL histwrite(nid_ctesGCM, "iperiod", itau_w, 35 35 . zx_tmp_2d,iip1*jjp1,ndex2d) 36 36 c 37 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(iapp_tracvl)37 zx_tmp_2d(1:iip1,1:jjp1)=REAL(iapp_tracvl) 38 38 CALL histwrite(nid_ctesGCM, "iapp_tracvl", itau_w, 39 39 . zx_tmp_2d,iip1*jjp1,ndex2d) 40 40 c 41 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(iconser)41 zx_tmp_2d(1:iip1,1:jjp1)=REAL(iconser) 42 42 CALL histwrite(nid_ctesGCM, "iconser", itau_w, 43 43 . zx_tmp_2d,iip1*jjp1,ndex2d) 44 44 c 45 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(iecri)45 zx_tmp_2d(1:iip1,1:jjp1)=REAL(iecri) 46 46 CALL histwrite(nid_ctesGCM, "iecri", itau_w, 47 47 . zx_tmp_2d,iip1*jjp1,ndex2d) … … 51 51 . zx_tmp_2d,iip1*jjp1,ndex2d) 52 52 c 53 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(idissip)53 zx_tmp_2d(1:iip1,1:jjp1)=REAL(idissip) 54 54 CALL histwrite(nid_ctesGCM, "idissip", itau_w, 55 55 . zx_tmp_2d,iip1*jjp1,ndex2d) … … 63 63 . zx_tmp_2d,iip1*jjp1,ndex2d) 64 64 c 65 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(nitergdiv)65 zx_tmp_2d(1:iip1,1:jjp1)=REAL(nitergdiv) 66 66 CALL histwrite(nid_ctesGCM, "nitergdiv", itau_w, 67 67 . zx_tmp_2d,iip1*jjp1,ndex2d) 68 68 c 69 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(nitergrot)69 zx_tmp_2d(1:iip1,1:jjp1)=REAL(nitergrot) 70 70 CALL histwrite(nid_ctesGCM, "nitergrot", itau_w, 71 71 . zx_tmp_2d,iip1*jjp1,ndex2d) 72 72 c 73 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(niterh)73 zx_tmp_2d(1:iip1,1:jjp1)=REAL(niterh) 74 74 CALL histwrite(nid_ctesGCM, "niterh", itau_w, 75 75 . zx_tmp_2d,iip1*jjp1,ndex2d) … … 118 118 . zx_tmp_2d,iip1*jjp1,ndex2d) 119 119 c 120 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(iflag_phys)120 zx_tmp_2d(1:iip1,1:jjp1)=REAL(iflag_phys) 121 121 CALL histwrite(nid_ctesGCM, "iflag_phys", itau_w, 122 122 . zx_tmp_2d,iip1*jjp1,ndex2d) 123 123 c 124 zx_tmp_2d(1:iip1,1:jjp1)= FLOAT(iphysiq)124 zx_tmp_2d(1:iip1,1:jjp1)=REAL(iphysiq) 125 125 CALL histwrite(nid_ctesGCM, "iphysiq", itau_w, 126 126 . zx_tmp_2d,iip1*jjp1,ndex2d)
Note: See TracChangeset
for help on using the changeset viewer.
