- Timestamp:
- Jan 20, 2010, 3:27:21 PM (15 years ago)
- Location:
- LMDZ4/branches/LMDZ4V5.0-dev/libf
- Files:
-
- 2 added
- 147 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/adaptdt.F
r524 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/advtrac.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/bilan_dyn.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/caladvtrac.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/calfis.F
r1279 r1299 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"99 100 100 101 c Arguments : -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/conf_gcm.F
r1279 r1299 6 6 SUBROUTINE conf_gcm( tapedef, etatinit, clesphy0 ) 7 7 c 8 USE control_mod 8 9 #ifdef CPP_IOIPSL 9 10 use IOIPSL … … 11 12 ! if not using IOIPSL, we still need to use (a local version of) getin 12 13 use ioipsl_getincom 14 13 15 #endif 14 16 IMPLICIT NONE … … 34 36 #include "dimensions.h" 35 37 #include "paramet.h" 36 #include "control.h"37 38 #include "logic.h" 38 39 #include "serre.h" -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/create_etat0_limit.F
r1279 r1299 6 6 ! This prog. is designed to work for Earth 7 7 USE dimphy 8 USE control_mod 8 9 USE comgeomphy 9 10 USE infotrac … … 34 35 #include "paramet.h" 35 36 #include "indicesol.h" 36 #include "control.h"37 37 REAL :: masque(iip1,jjp1) 38 38 ! REAL :: pctsrf(iim*(jjm-1)+2, nbsrf) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/defrun.F
r956 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/disvert.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/dynredem.F
r1279 r1299 8 8 #endif 9 9 USE infotrac 10 10 11 IMPLICIT NONE 11 12 c======================================================================= … … 72 73 tab_cntrl(l) = 0. 73 74 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)75 tab_cntrl(1) = REAL(iim) 76 tab_cntrl(2) = REAL(jjm) 77 tab_cntrl(3) = REAL(llm) 78 tab_cntrl(4) = REAL(day_ref) 79 tab_cntrl(5) = REAL(annee_ref) 79 80 tab_cntrl(6) = rad 80 81 tab_cntrl(7) = omeg … … 116 117 ENDIF 117 118 118 tab_cntrl(30) = FLOAT(iday_end)119 tab_cntrl(31) = FLOAT(itau_dyn + itaufin)119 tab_cntrl(30) = REAL(iday_end) 120 tab_cntrl(31) = REAL(itau_dyn + itaufin) 120 121 c 121 122 c ......................................................... … … 517 518 . vcov,ucov,teta,q,masse,ps) 518 519 USE infotrac 520 USE control_mod 521 519 522 IMPLICIT NONE 520 523 c================================================================= … … 528 531 #include "comgeom.h" 529 532 #include "temps.h" 530 #include "control.h"531 533 532 534 INTEGER l … … 589 591 ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl) 590 592 #endif 591 tab_cntrl(31) = FLOAT(itau_dyn + itaufin)593 tab_cntrl(31) = REAL(itau_dyn + itaufin) 592 594 #ifdef NC_DOUBLE 593 595 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/etat0_netcdf.F
r1293 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 9 9 USE ioipsl 10 10 USE dimphy 11 USE control_mod 11 12 USE infotrac 12 13 USE fonte_neige_mod … … 89 90 90 91 #include "comdissnew.h" 91 #include "control.h"92 92 #include "serre.h" 93 93 #include "clesphys.h" … … 189 189 co2_ppm0 = co2_ppm 190 190 191 dtvr = daysec/ FLOAT(day_step)191 dtvr = daysec/REAL(day_step) 192 192 print*,'dtvr',dtvr 193 193 … … 691 691 C 692 692 write(*,*)'phystep ',dtvr,iphysiq,nbapp_rad 693 phystep = dtvr * FLOAT(iphysiq)694 radpas = NINT (86400./phystep/ FLOAT(nbapp_rad) )693 phystep = dtvr * REAL(iphysiq) 694 radpas = NINT (86400./phystep/ REAL(nbapp_rad) ) 695 695 write(*,*)'phystep =', phystep, radpas 696 696 cIM : lecture de co2_ppm & solaire ds physiq.def -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/extrapol.F
r524 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/fluxstokenc.F
r1279 r1299 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 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/friction.F
r524 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/fxhyp.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/fxy.F
r524 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/fxysinus.F
r524 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/fyhyp.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/gcm.F
r1279 r1299 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" … … 292 293 ENDIF 293 294 294 zdtvr = daysec/ FLOAT(day_step)295 zdtvr = daysec/REAL(day_step) 295 296 IF(dtvr.NE.zdtvr) THEN 296 297 WRITE(lunout,*) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/grid_atob.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/grid_noro.F
r773 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/grilles_gcm_netcdf.F
r636 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/guide_mod.F90
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/infotrac.F90
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/iniacademic.F
r1279 r1299 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" 48 49 … … 93 94 g = 9.8 94 95 daysec = 86400. 95 dtvr = daysec/ FLOAT(day_step)96 dtvr = daysec/REAL(day_step) 96 97 zdtvr=dtvr 97 98 kappa = 0.2857143 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/iniconst.F
r524 r1299 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" 20 21 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/inidissip.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/inigeom.F
r524 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/integrd.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/interp_horiz.F
r616 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/interpre.F
r524 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/juldate.F
r524 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 subroutine juldate(ian,imoi,ijou,oh,om,os,tjd,tjdsec) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/leapfrog.F
r1286 r1299 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" … … 198 198 itau = 0 199 199 c$$$ iday = day_ini+itau/day_step 200 c$$$ time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0200 c$$$ time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 201 201 c$$$ IF(time.GT.1.) THEN 202 202 c$$$ time = time-1. … … 523 523 itau= itau + 1 524 524 c$$$ iday= day_ini+itau/day_step 525 c$$$ time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0525 c$$$ time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 526 526 c$$$ IF(time.GT.1.) THEN 527 527 c$$$ time = time-1. … … 646 646 itau = itau + 1 647 647 c$$$ iday = day_ini+itau/day_step 648 c$$$ time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_0648 c$$$ time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 649 649 c$$$ 650 650 c$$$ IF(time.GT.1.) THEN -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/limit_netcdf.F
r1293 r1299 10 10 use phys_state_var_mod , ONLY : pctsrf 11 11 use inter_barxy_m, only: inter_barxy 12 USE control_mod 12 13 13 14 IMPLICIT none … … 29 30 #include "dimensions.h" 30 31 #include "paramet.h" 31 #include "control.h"32 32 #include "logic.h" 33 33 #include "netcdf.inc" … … 148 148 kappa = 0.2857143 149 149 cpp = 1004.70885 150 dtvr = daysec/ FLOAT(day_step)150 dtvr = daysec/REAL(day_step) 151 151 CALL inigeom 152 152 c … … 418 418 CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) 419 419 DO k = 1, 360 420 time = FLOAT(k-1)420 time = REAL(k-1) 421 421 CALL SPLINT(ax,ay,yder,lmdep,time,by) 422 422 champan(i,j,k) = by … … 632 632 CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) 633 633 DO k = 1, 360 634 time = FLOAT(k-1)634 time = REAL(k-1) 635 635 CALL SPLINT(ax,ay,yder,lmdep,time,by) 636 636 champan(i,j,k) = by … … 951 951 CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) 952 952 DO k = 1, 360 953 time = FLOAT(k-1)953 time = REAL(k-1) 954 954 CALL SPLINT(ax,ay,yder,lmdep,time,by) 955 955 champan(i,j,k) = by … … 1146 1146 CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) 1147 1147 DO k = 1, 360 1148 time = FLOAT(k-1)1148 time = REAL(k-1) 1149 1149 CALL SPLINT(ax,ay,yder,lmdep,time,by) 1150 1150 champan(i,j,k) = by … … 1300 1300 ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k)) 1301 1301 #else 1302 ierr = NF_PUT_VAR1_REAL (nid,id_tim,k, FLOAT(k))1302 ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,REAL(k)) 1303 1303 IF (newlmt ) THEN 1304 1304 ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/ppm3d.F
r695 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/ran1.F
r524 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/sortvarc.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/sortvarc0.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/startvar.F
r1293 r1299 352 352 phis = phis * 9.81 353 353 ! 354 ! masque(:,:) = FLOAT(tmp_int(:,:))354 ! masque(:,:) = REAL(tmp_int(:,:)) 355 355 ! 356 356 ! Compute surface roughness -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/tourabs.F
r644 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/traceurpole.F
r524 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/ugeostr.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3d/write_paramLMDZ_dyn.h
r1279 r1299 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) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/adaptdt.F
r774 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/advtrac_p.F
r1146 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/bilan_dyn_p.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/caladvtrac_p.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/calfis_p.F
r1279 r1299 41 41 USE IOPHY 42 42 USE infotrac 43 USE control_mod 43 44 44 45 IMPLICIT NONE … … 107 108 #include "comvert.h" 108 109 #include "comgeom2.h" 109 #include "control.h"110 110 #ifdef CPP_MPI 111 111 include 'mpif.h' -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/conf_gcm.F
r1279 r1299 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" -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/create_etat0_limit.F
r1279 r1299 10 10 USE mod_const_mpi 11 11 USE infotrac 12 USE control_mod 12 13 #ifdef CPP_IOIPSL 13 14 use ioipsl, only: ioconf_calendar … … 36 37 #include "paramet.h" 37 38 #include "indicesol.h" 38 #include "control.h"39 39 REAL :: masque(iip1,jjp1) 40 40 ! REAL :: pctsrf(iim*(jjm-1)+2, nbsrf) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/defrun.F
r985 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/disvert.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/dynredem.F
r1279 r1299 72 72 tab_cntrl(l) = 0. 73 73 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)74 tab_cntrl(1) = REAL(iim) 75 tab_cntrl(2) = REAL(jjm) 76 tab_cntrl(3) = REAL(llm) 77 tab_cntrl(4) = REAL(day_ref) 78 tab_cntrl(5) = REAL(annee_ref) 79 79 tab_cntrl(6) = rad 80 80 tab_cntrl(7) = omeg … … 116 116 ENDIF 117 117 118 tab_cntrl(30) = FLOAT(iday_end)119 tab_cntrl(31) = FLOAT(itau_dyn + itaufin)118 tab_cntrl(30) = REAL(iday_end) 119 tab_cntrl(31) = REAL(itau_dyn + itaufin) 120 120 c 121 121 c ......................................................... … … 517 517 . vcov,ucov,teta,q,masse,ps) 518 518 USE infotrac 519 USE control_mod 519 520 IMPLICIT NONE 520 521 c================================================================= … … 528 529 #include "comgeom.h" 529 530 #include "temps.h" 530 #include "control.h"531 531 532 532 INTEGER l … … 589 589 ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl) 590 590 #endif 591 tab_cntrl(31) = FLOAT(itau_dyn + itaufin)591 tab_cntrl(31) = REAL(itau_dyn + itaufin) 592 592 #ifdef NC_DOUBLE 593 593 ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/dynredem_p.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/etat0_netcdf.F
r1293 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 14 14 USE phys_state_var_mod 15 15 USE filtreg_mod 16 USE control_mod 16 17 use regr_lat_time_climoz_m, only: regr_lat_time_climoz 17 18 use conf_phys_m, only: conf_phys … … 89 90 90 91 #include "comdissnew.h" 91 #include "control.h"92 92 #include "serre.h" 93 93 #include "clesphys.h" … … 189 189 co2_ppm0 = co2_ppm 190 190 191 dtvr = daysec/ FLOAT(day_step)191 dtvr = daysec/REAL(day_step) 192 192 print*,'dtvr',dtvr 193 193 … … 691 691 C 692 692 write(*,*)'phystep ',dtvr,iphysiq,nbapp_rad 693 phystep = dtvr * FLOAT(iphysiq)694 radpas = NINT (86400./phystep/ FLOAT(nbapp_rad) )693 phystep = dtvr * REAL(iphysiq) 694 radpas = NINT (86400./phystep/ REAL(nbapp_rad) ) 695 695 write(*,*)'phystep =', phystep, radpas 696 696 cIM : lecture de co2_ppm & solaire ds physiq.def -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/extrapol.F
r774 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/fluxstokenc_p.F
r1279 r1299 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 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/friction_p.F
r774 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/fxhyp.F
r764 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/fxy.F
r774 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/fxysinus.F
r774 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/fyhyp.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/gcm.F
r1279 r1299 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" … … 308 308 ENDIF 309 309 310 zdtvr = daysec/ FLOAT(day_step)310 zdtvr = daysec/REAL(day_step) 311 311 IF(dtvr.NE.zdtvr) THEN 312 312 WRITE(lunout,*) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/grid_atob.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/grid_noro.F
r764 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/grilles_gcm_netcdf.F
r764 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/guide_p_mod.F90
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/infotrac.F90
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/iniacademic.F
r1279 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 31 31 c 32 32 c======================================================================= 33 USE control_mod 33 34 IMPLICIT NONE 34 35 c----------------------------------------------------------------------- … … 44 45 #include "ener.h" 45 46 #include "temps.h" 46 #include "control.h"47 47 #include "iniprint.h" 48 48 … … 93 93 g = 9.8 94 94 daysec = 86400. 95 dtvr = daysec/ FLOAT(day_step)95 dtvr = daysec/REAL(day_step) 96 96 zdtvr=dtvr 97 97 kappa = 0.2857143 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/iniconst.F
r774 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE iniconst 5 5 6 USE control_mod 6 7 IMPLICIT NONE 7 8 c … … 16 17 #include "comconst.h" 17 18 #include "temps.h" 18 #include "control.h"19 19 #include "comvert.h" 20 20 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/inidissip.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/inigeom.F
r774 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/integrd_p.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/interpre.F
r774 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/leapfrog_p.F
r1286 r1299 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" … … 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. … … 1280 1280 itau= itau + 1 1281 1281 ! iday= day_ini+itau/day_step 1282 ! time= FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_01282 ! time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 1283 1283 ! IF(time.GT.1.) THEN 1284 1284 ! time = time-1. … … 1458 1458 itau = itau + 1 1459 1459 ! iday = day_ini+itau/day_step 1460 ! time = FLOAT(itau-(iday-day_ini)*day_step)/day_step+time_01460 ! time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0 1461 1461 ! 1462 1462 ! IF(time.GT.1.) THEN -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/limit_netcdf.F
r1293 r1299 8 8 ! This routine is designed to work for Earth 9 9 USE dimphy 10 USE control_mod 10 11 use phys_state_var_mod , ONLY : pctsrf 11 12 use inter_barxy_m, only: inter_barxy … … 29 30 #include "dimensions.h" 30 31 #include "paramet.h" 31 #include "control.h"32 32 #include "logic.h" 33 33 #include "netcdf.inc" … … 148 148 kappa = 0.2857143 149 149 cpp = 1004.70885 150 dtvr = daysec/ FLOAT(day_step)150 dtvr = daysec/ REAL(day_step) 151 151 CALL inigeom 152 152 c … … 418 418 CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) 419 419 DO k = 1, 360 420 time = FLOAT(k-1)420 time = REAL(k-1) 421 421 CALL SPLINT(ax,ay,yder,lmdep,time,by) 422 422 champan(i,j,k) = by … … 632 632 CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) 633 633 DO k = 1, 360 634 time = FLOAT(k-1)634 time = REAL(k-1) 635 635 CALL SPLINT(ax,ay,yder,lmdep,time,by) 636 636 champan(i,j,k) = by … … 951 951 CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) 952 952 DO k = 1, 360 953 time = FLOAT(k-1)953 time = REAL(k-1) 954 954 CALL SPLINT(ax,ay,yder,lmdep,time,by) 955 955 champan(i,j,k) = by … … 1146 1146 CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder) 1147 1147 DO k = 1, 360 1148 time = FLOAT(k-1)1148 time = REAL(k-1) 1149 1149 CALL SPLINT(ax,ay,yder,lmdep,time,by) 1150 1150 champan(i,j,k) = by … … 1300 1300 ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k)) 1301 1301 #else 1302 ierr = NF_PUT_VAR1_REAL (nid,id_tim,k, FLOAT(k))1302 ierr = NF_PUT_VAR1_REAL (nid,id_tim,k, REAL(k)) 1303 1303 IF (newlmt ) THEN 1304 1304 ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/ppm3d.F
r764 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/ran1.F
r774 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/sortvarc.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/sortvarc0.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/startvar.F
r1293 r1299 352 352 phis = phis * 9.81 353 353 ! 354 ! masque(:,:) = FLOAT(tmp_int(:,:))354 ! masque(:,:) = REAL(tmp_int(:,:)) 355 355 ! 356 356 ! Compute surface roughness -
LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/tourabs.F
r763 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/traceurpole.F
r774 r1299 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/branches/LMDZ4V5.0-dev/libf/dyn3dpar/ugeostr.F
r1279 r1299 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/branches/LMDZ4V5.0-dev/libf/grid/fxy_new.h
r524 r1299 8 8 c....stretching in x... 9 9 c 10 ripx( ri )= (ri-1.0) *2.*pi/ FLOAT(iim)10 ripx( ri )= (ri-1.0) *2.*pi/REAL(iim) 11 11 fx ( ri )= ripx(ri) + transx + 12 12 * alphax * SIN( ripx(ri)+transx-pxo ) - pi 13 fxprim(ri) = 2.*pi/ FLOAT(iim) *13 fxprim(ri) = 2.*pi/REAL(iim) * 14 14 * ( 1.+ alphax * COS( ripx(ri)+transx-pxo ) ) 15 15 16 16 c....stretching in y... 17 17 c 18 bigy(rj) = 2.* ( FLOAT(jjp1)-rj ) *pi/jjm18 bigy(rj) = 2.* (REAL(jjp1)-rj ) *pi/jjm 19 19 fy(rj) = ( bigy(rj) + transy + 20 20 * alphay * SIN( bigy(rj)+transy-pyo ) ) /2. - pi/2. -
LMDZ4/branches/LMDZ4V5.0-dev/libf/grid/fxy_reg.h
r524 r1299 13 13 c 14 14 c 15 fy ( rj ) = pi/ FLOAT(jjm) * ( 0.5 * FLOAT(jjm) + 1. - rj )16 fyprim( rj ) = pi/ FLOAT(jjm)15 fy ( rj ) = pi/REAL(jjm) * ( 0.5 * REAL(jjm) + 1. - rj ) 16 fyprim( rj ) = pi/REAL(jjm) 17 17 18 c fy(rj)=ASIN(1.+2.*((1.-rj)/ FLOAT(jjm)))18 c fy(rj)=ASIN(1.+2.*((1.-rj)/REAL(jjm))) 19 19 c fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj)) 20 20 21 fx ( ri ) = 2.*pi/ FLOAT(iim) * ( ri - 0.5* FLOAT(iim) - 1. )22 c fx ( ri ) = 2.*pi/ FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )23 fxprim( ri ) = 2.*pi/ FLOAT(iim)21 fx ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5* REAL(iim) - 1. ) 22 c fx ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5* ( REAL(iim) + 1.) ) 23 fxprim( ri ) = 2.*pi/REAL(iim) 24 24 c 25 25 c -
LMDZ4/branches/LMDZ4V5.0-dev/libf/grid/fxy_sin.h
r524 r1299 13 13 c 14 14 c 15 fy(rj)=ASIN(1.+2.*((1.-rj)/ FLOAT(jjm)))15 fy(rj)=ASIN(1.+2.*((1.-rj)/REAL(jjm))) 16 16 fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj)) 17 17 18 fx ( ri ) = 2.*pi/ FLOAT(iim) * ( ri - 0.5* FLOAT(iim) - 1. )19 c fx ( ri ) = 2.*pi/ FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )20 fxprim( ri ) = 2.*pi/ FLOAT(iim)18 fx ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5* REAL(iim) - 1. ) 19 c fx ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5* ( REAL(iim) + 1.) ) 20 fxprim( ri ) = 2.*pi/REAL(iim) 21 21 c 22 22 c -
LMDZ4/branches/LMDZ4V5.0-dev/libf/grid/fxyprim.h
r524 r1299 13 13 c 14 14 c 15 fy ( rj ) = pi/ FLOAT(jjm) * ( 0.5 * FLOAT(jjm) + 1. - rj )16 fyprim( rj ) = pi/ FLOAT(jjm)15 fy ( rj ) = pi/REAL(jjm) * ( 0.5 * REAL(jjm) + 1. - rj ) 16 fyprim( rj ) = pi/REAL(jjm) 17 17 18 c fy(rj)=ASIN(1.+2.*((1.-rj)/ FLOAT(jjm)))18 c fy(rj)=ASIN(1.+2.*((1.-rj)/REAL(jjm))) 19 19 c fyprim(rj)=1./SQRT((rj-1.)*(jjm+1.-rj)) 20 20 21 fx ( ri ) = 2.*pi/ FLOAT(iim) * ( ri - 0.5* FLOAT(iim) - 1. )22 c fx ( ri ) = 2.*pi/ FLOAT(iim) * ( ri - 0.5* ( FLOAT(iim) + 1.) )23 fxprim( ri ) = 2.*pi/ FLOAT(iim)21 fx ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5* REAL(iim) - 1. ) 22 c fx ( ri ) = 2.*pi/REAL(iim) * ( ri - 0.5* ( REAL(iim) + 1.) ) 23 fxprim( ri ) = 2.*pi/REAL(iim) 24 24 c 25 25 c -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/aaam_bud.F
r1279 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 subroutine aaam_bud (iam,nlon,nlev,rjour,rsec, … … 117 117 REAL BLSU(801,401),BLSV(801,401) 118 118 REAL ZLON(801),ZLAT(401) 119 120 CHARACTER (LEN=20) :: modname='aaam_bud' 121 CHARACTER (LEN=80) :: abort_message 122 123 119 124 C 120 125 C PUT AAM QUANTITIES AT ZERO: 121 126 C 122 127 if(iim+1.gt.801.or.jjm+1.gt.401)then 123 print *,'Pb de dimension dans aaam_bud'124 stop128 abort_message = 'Pb de dimension dans aaam_bud' 129 CALL abort_gcm (modname,abort_message,1) 125 130 endif 126 131 … … 128 133 hadley=1.e18 129 134 hadday=1.e18*24.*3600. 130 dlat=xpi/ float(jjm)131 dlon=2.*xpi/ float(iim)135 dlat=xpi/REAL(jjm) 136 dlon=2.*xpi/REAL(iim) 132 137 133 138 do iax=1,3 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/aeropt.F
r1279 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE aeropt(pplay, paprs, t_seri, msulfate, RHcl, … … 39 39 REAL alpha_aer_sulfate(nbre_RH,5) !--unit m2/g SO4 40 40 REAL alphasulfate 41 42 CHARACTER (LEN=20) :: modname='aeropt' 43 CHARACTER (LEN=80) :: abort_message 44 41 45 c 42 46 c Proprietes optiques … … 85 89 rh=MIN(RHcl(i,k)*100.,RH_MAX) 86 90 RH_num = INT( rh/10. + 1.) 87 IF (rh.LT.0.) STOP 'aeropt: RH < 0 not possible' 91 IF (rh.LT.0.) THEN 92 abort_message = 'aeropt: RH < 0 not possible' 93 CALL abort_gcm (modname,abort_message,1) 94 ENDIF 88 95 IF (rh.gt.85.) RH_num=10 89 96 IF (rh.gt.90.) RH_num=11 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/aeropt_5wv.F90
r1279 r1299 621 621 DO k=1, klev 622 622 DO i=1, klon 623 ! IF (t_seri(i,k).EQ.0) stop 'stop aeropt_5wv T '624 ! IF (pplay(i,k).EQ.0) stop 'stop aeropt_5wv p '625 623 zrho=pplay(i,k)/t_seri(i,k)/RD ! kg/m3 626 624 !CDIR UNROLL=naero_spc -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/albedo.F
r900 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 67 67 c prend en compte l'autre moitie de la journee): 68 68 DO k = 1, npts 69 rmu = aa + bb * COS( FLOAT(k)/FLOAT(npts)*zpi)69 rmu = aa + bb * COS(REAL(k)/REAL(npts)*zpi) 70 70 rmu = MAX(0.0, rmu) 71 71 fauxo = (1.47-ACOS(rmu))/.15 … … 110 110 c prend en compte l'autre moitie de la journee): 111 111 DO k = 1, npts 112 rmu = aa + bb * COS( FLOAT(k)/FLOAT(npts)*zpi)112 rmu = aa + bb * COS(REAL(k)/REAL(npts)*zpi) 113 113 rmu = MAX(0.0, rmu) 114 114 cIM cf. PB alb = 0.058/(rmu + 0.30) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/calcul_simulISCCP.h
r1279 r1299 1 1 c 2 c $ Header$2 c $Id$ 3 3 c 4 4 c on appelle le simulateur ISCCP toutes les 3h … … 18 18 sunlit(i)=1 19 19 IF(rmu0(i).EQ.0.) sunlit(i)=0 20 nbsunlit(1,i,n)= FLOAT(sunlit(i))20 nbsunlit(1,i,n)=REAL(sunlit(i)) 21 21 ENDDO 22 22 c … … 88 88 print*,'seed=0 i paprs aa seed_re', 89 89 . i,paprs(i,2),aa,seed_re(i,n) 90 STOP 90 abort_message = '' 91 CALL abort_gcm (modname,abort_message,1) 91 92 ELSE IF(seed(i,n).LT.0) THEN 92 93 print*,'seed < 0, i seed itap paprs',i, 93 94 . seed(i,n),itap,paprs(i,2) 94 STOP 95 abort_message = '' 96 CALL abort_gcm (modname,abort_message,1) 95 97 ENDIF 96 98 c -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/calltherm.F90
r1295 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 subroutine calltherm(dtime & … … 83 83 ! save zentr_therm,zfm_therm 84 84 85 character (len=20) :: modname='calltherm' 86 character (len=80) :: abort_message 87 85 88 integer i,k 86 89 logical, save :: first=.true. … … 137 140 if(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb 138 141 139 zdt=dtime/ float(nsplit_thermals)142 zdt=dtime/REAL(nsplit_thermals) 140 143 do isplit=1,nsplit_thermals 141 144 … … 173 176 & ,tau_thermals,3) 174 177 else if (iflag_thermals.eq.11) then 175 stop 'cas non prevu dans calltherm' 178 abort_message = 'cas non prevu dans calltherm' 179 CALL abort_gcm (modname,abort_message,1) 180 176 181 ! CALL thermcell_pluie(klon,klev,zdt & 177 182 ! & ,pplay,paprs,pphi,zlev & … … 210 215 if (prt_level.gt.10) write(lunout,*)'Apres thermcell_main OK' 211 216 else 212 STOP'Cas des thermiques non prevu' 217 abort_message = 'Cas des thermiques non prevu' 218 CALL abort_gcm (modname,abort_message,1) 213 219 endif 214 220 … … 218 224 DO i=1,klon 219 225 logexpr1(i)=flag_bidouille_stratocu.or.weak_inversion(i).gt.0.5 220 IF(logexpr1(i)) fact(i)=1./ float(nsplit_thermals)226 IF(logexpr1(i)) fact(i)=1./REAL(nsplit_thermals) 221 227 ENDDO 222 228 … … 255 261 if(prt_level.GE.10) print*,'calltherm i Alp_bl Alp Ale_bl Ale',i,Alp_bl(i),Alp(i),Ale_bl(i),Ale(i) 256 262 fm_therm(i,klev+1)=0. 257 Ale_bl(i)=Ale_bl(i)+Ale(i)/ float(nsplit_thermals)263 Ale_bl(i)=Ale_bl(i)+Ale(i)/REAL(nsplit_thermals) 258 264 ! write(22,*)'ALE CALLTHERM',Ale_bl(i),Ale(i) 259 Alp_bl(i)=Alp_bl(i)+Alp(i)/ float(nsplit_thermals)265 Alp_bl(i)=Alp_bl(i)+Alp(i)/REAL(nsplit_thermals) 260 266 ! write(23,*)'ALP CALLTHERM',Alp_bl(i),Alp(i) 261 267 ENDDO … … 276 282 ! & 'fm=',zfm_therm(i,k),'entr=',entr_therm(i,k) 277 283 endif 278 ! stop279 284 ENDDO 280 285 ENDDO -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/conema3.F
r1146 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE conema3 (dtime,paprs,pplay,t,q,u,v,tra,ntra, … … 360 360 cape(i) = em_CAPE 361 361 wd(i) = em_wd 362 rflag(i) = float(iflag)362 rflag(i) = REAL(iflag) 363 363 c SB kbas(i) = em_bas 364 364 c SB ktop(i) = em_top -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/conf_phys.F90
r1286 r1299 27 27 USE surface_data 28 28 USE carbon_cycle_mod, ONLY : carbon_cycle_tr, carbon_cycle_cpl 29 use control_mod 29 30 30 31 include "conema3.h" … … 36 37 include "clesphys.h" 37 38 include "compbl.h" 38 include "control.h"39 39 include "comsoil.h" 40 40 ! -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/convect2.F
r766 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 subroutine convect2(ncum,idcum,len,nd,ndp1,nl,minorig, -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/cpl_mod.F90
r1279 r1299 24 24 USE oasis 25 25 USE write_field_phy 26 USE control_mod 27 26 28 27 29 ! Global attributes … … 101 103 INCLUDE "dimensions.h" 102 104 INCLUDE "indicesol.h" 103 INCLUDE "control.h"104 105 INCLUDE "temps.h" 105 106 INCLUDE "iniprint.h" … … 583 584 DO ig = 1, knon 584 585 cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + & 585 swdown(ig) / FLOAT(nexca)586 swdown(ig) / REAL(nexca) 586 587 cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + & 587 (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / FLOAT(nexca)588 (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca) 588 589 cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + & 589 precip_rain(ig) / FLOAT(nexca)590 precip_rain(ig) / REAL(nexca) 590 591 cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + & 591 precip_snow(ig) / FLOAT(nexca)592 precip_snow(ig) / REAL(nexca) 592 593 cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + & 593 evap(ig) / FLOAT(nexca)594 evap(ig) / REAL(nexca) 594 595 cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + & 595 tsurf(ig) / FLOAT(nexca)596 tsurf(ig) / REAL(nexca) 596 597 cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + & 597 fder(ig) / FLOAT(nexca)598 fder(ig) / REAL(nexca) 598 599 cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + & 599 albsol(ig) / FLOAT(nexca)600 albsol(ig) / REAL(nexca) 600 601 cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + & 601 taux(ig) / FLOAT(nexca)602 taux(ig) / REAL(nexca) 602 603 cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + & 603 tauy(ig) / FLOAT(nexca)604 tauy(ig) / REAL(nexca) 604 605 cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) + & 605 windsp(ig) / FLOAT(nexca)606 windsp(ig) / REAL(nexca) 606 607 cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + & 607 SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / FLOAT(nexca)608 SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / REAL (nexca) 608 609 609 610 IF (carbon_cycle_cpl) THEN 610 611 cpl_atm_co2(ig,cpl_index) = cpl_atm_co2(ig,cpl_index) + & 611 co2_send(knindex(ig))/ FLOAT(nexca)612 co2_send(knindex(ig))/ REAL(nexca) 612 613 END IF 613 614 ENDDO … … 777 778 DO ig = 1, knon 778 779 cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + & 779 swdown(ig) / FLOAT(nexca)780 swdown(ig) / REAL(nexca) 780 781 cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + & 781 (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / FLOAT(nexca)782 (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca) 782 783 cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + & 783 precip_rain(ig) / FLOAT(nexca)784 precip_rain(ig) / REAL(nexca) 784 785 cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + & 785 precip_snow(ig) / FLOAT(nexca)786 precip_snow(ig) / REAL(nexca) 786 787 cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + & 787 evap(ig) / FLOAT(nexca)788 evap(ig) / REAL(nexca) 788 789 cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + & 789 tsurf(ig) / FLOAT(nexca)790 tsurf(ig) / REAL(nexca) 790 791 cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + & 791 fder(ig) / FLOAT(nexca)792 fder(ig) / REAL(nexca) 792 793 cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + & 793 albsol(ig) / FLOAT(nexca)794 albsol(ig) / REAL(nexca) 794 795 cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + & 795 taux(ig) / FLOAT(nexca)796 taux(ig) / REAL(nexca) 796 797 cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + & 797 tauy(ig) / FLOAT(nexca)798 tauy(ig) / REAL(nexca) 798 799 cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + & 799 SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / FLOAT(nexca)800 SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / REAL(nexca) 800 801 ENDDO 801 802 … … 944 945 !************************************************************************************* 945 946 !$OMP MASTER 946 cpl_rriv2D(:,:) = cpl_rriv2D(:,:) + rriv2D(:,:) / FLOAT(nexca)947 cpl_rcoa2D(:,:) = cpl_rcoa2D(:,:) + rcoa2D(:,:) / FLOAT(nexca)947 cpl_rriv2D(:,:) = cpl_rriv2D(:,:) + rriv2D(:,:) / REAL(nexca) 948 cpl_rcoa2D(:,:) = cpl_rcoa2D(:,:) + rcoa2D(:,:) / REAL(nexca) 948 949 !$OMP END MASTER 949 950 … … 998 999 !************************************************************************************* 999 1000 !$OMP MASTER 1000 cpl_rlic2D(:,:) = cpl_rlic2D(:,:) + rlic2D(:,:) / FLOAT(nexca)1001 cpl_rlic2D(:,:) = cpl_rlic2D(:,:) + rlic2D(:,:) / REAL(nexca) 1001 1002 !$OMP END MASTER 1002 1003 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/cv30_routines.F
r879 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 749 749 750 750 #include "cv30param.h" 751 include 'iniprint.h' 751 752 752 753 c inputs: … … 778 779 c local variables: 779 780 integer i,k,nn,j 781 782 CHARACTER (LEN=20) :: modname='cv30_compress' 783 CHARACTER (LEN=80) :: abort_message 780 784 781 785 … … 820 824 821 825 if (nn.ne.ncum) then 822 print*,'strange! nn not equal to ncum: ',nn,ncum 823 stop 826 write(lunout,*)'strange! nn not equal to ncum: ',nn,ncum 827 abort_message = '' 828 CALL abort_gcm (modname,abort_message,1) 824 829 endif 825 830 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/cv3_inicp.F
r966 r1299 13 13 c 14 14 INTEGER iflag_clos 15 CHARACTER (LEN=20) :: modname='cv3_inicp' 16 CHARACTER (LEN=80) :: abort_message 15 17 c 16 18 c -- Mixing probability distribution functions … … 105 107 if (abs(aire-1.0) .gt. 0.02) then 106 108 print *,'WARNING:: AREA OF MIXING PDF IS::', aire 107 stop 109 abort_message = '' 110 CALL abort_gcm (modname,abort_message,1) 108 111 else 109 112 print *,'Area, mean & std deviation are ::', aire,mu,sigma -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/cv3_inip.F
r1146 r1299 12 12 c 13 13 c INTEGER iflag_mix 14 include 'iniprint.h' 15 16 CHARACTER (LEN=20) :: modname='cv3_inip' 17 CHARACTER (LEN=80) :: abort_message 18 14 19 c 15 20 c -- Mixing probability distribution functions … … 104 109 c 105 110 if (abs(aire-1.0) .gt. 0.02) then 106 print *,'WARNING:: AREA OF MIXING PDF IS::', aire 107 stop 111 write(lunout,*)'WARNING:: AREA OF MIXING PDF IS::', aire 112 abort_message = '' 113 CALL abort_gcm (modname,abort_message,1) 108 114 else 109 115 print *,'Area, mean & std deviation are ::', aire,mu,sigma -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/cv3_routines.F
r1277 r1299 1 1 ! 2 ! $ Header: /home/cvsroot/LMDZ4/libf/phylmd/cv3_routines.F,v 1.16 2008-11-06 16:29:35 lmdzadmin Exp$2 ! $Id$ 3 3 ! 4 4 c … … 35 35 integer nd 36 36 real delt ! timestep (seconds) 37 38 CHARACTER (LEN=20) :: modname='cv3_param' 39 CHARACTER (LEN=80) :: abort_message 37 40 38 41 c noff: integer limit for convection (nd-noff) … … 767 770 768 771 #include "cv3param.h" 772 include 'iniprint.h' 769 773 770 774 c inputs: … … 797 801 integer i,k,nn,j 798 802 803 CHARACTER (LEN=20) :: modname='cv3_compress' 804 CHARACTER (LEN=80) :: abort_message 799 805 800 806 do 110 k=1,nl+1 … … 839 845 840 846 if (nn.ne.ncum) then 841 print*,'strange! nn not equal to ncum: ',nn,ncum 842 stop 847 write(lunout,*)'strange! nn not equal to ncum: ',nn,ncum 848 abort_message = '' 849 CALL abort_gcm (modname,abort_message,1) 843 850 endif 844 851 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/cv3a_compress.F
r1146 r1299 76 76 integer i,k,nn,j 77 77 78 CHARACTER (LEN=20) :: modname='cv3a_compress' 79 CHARACTER (LEN=80) :: abort_message 80 78 81 79 82 do 110 k=1,nl+1 … … 127 130 128 131 if (nn.ne.ncum) then 129 print*,'WARNING nn not equal to ncum: ',nn,ncum 130 stop 132 print*,'WARNING nn not equal to ncum: ',nn,ncum 133 abort_message = '' 134 CALL abort_gcm (modname,abort_message,1) 131 135 endif 132 136 … … 157 161 if (nn.ne.ncum) then 158 162 print*,'WARNING nn not equal to ncum: ',nn,ncum 159 stop 163 abort_message = '' 164 CALL abort_gcm (modname,abort_message,1) 160 165 endif 161 166 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/cv3p1_closure.F
r973 r1299 1 ! 2 ! $Id$ 3 ! 1 4 SUBROUTINE cv3p1_closure(nloc,ncum,nd,icb,inb 2 5 : ,pbase,plcl,p,ph,tv,tvp,buoy … … 74 77 real wb,sigmax 75 78 data wb /2./, sigmax /0.1/ 79 80 CHARACTER (LEN=20) :: modname='cv3p1_closure' 81 CHARACTER (LEN=80) :: abort_message 76 82 c 77 83 c print *,' -> cv3p1_closure, Ale ',ale(1) … … 509 515 cbmf1(il) = alp2(il)/(0.5*wb*wb-Cin(il)) 510 516 if(cbmf1(il).EQ.0.AND.alp2(il).NE.0.) THEN 511 print*,'cv3p1_closure cbmf1=0 and alp NE 0 il alp2 alp cin ',il, 517 write(lunout,*) 518 & 'cv3p1_closure cbmf1=0 and alp NE 0 il alp2 alp cin ',il, 512 519 . alp2(il),alp(il),cin(il) 513 STOP 520 abort_message = '' 521 CALL abort_gcm (modname,abort_message,1) 514 522 endif 515 523 cbmfmax(il) = sigmax*wb2(il)*100.*p(il,icb(il)) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/cv_routines.F
r524 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE cv_param(nd) … … 38 38 #include "cvparam.h" 39 39 integer nd 40 CHARACTER (LEN=20) :: modname='cv_routines' 41 CHARACTER (LEN=80) :: abort_message 40 42 41 43 c noff: integer limit for convection (nd-noff) … … 429 431 c local variables: 430 432 integer i,k,nn 433 CHARACTER (LEN=20) :: modname='cv_compress' 434 CHARACTER (LEN=80) :: abort_message 435 436 include 'iniprint.h' 431 437 432 438 … … 456 462 457 463 if (nn.ne.ncum) then 458 print*,'strange! nn not equal to ncum: ',nn,ncum 459 stop 464 write(lunout,*)'strange! nn not equal to ncum: ',nn,ncum 465 abort_message = '' 466 CALL abort_gcm (modname,abort_message,1) 460 467 endif 461 468 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/cva_driver.F
r1279 r1299 106 106 #include "dimensions.h" 107 107 ccccc#include "dimphy.h" 108 include 'iniprint.h' 109 108 110 c 109 111 c Input … … 419 421 logical, save :: first=.true. 420 422 c$OMP THREADPRIVATE(first) 423 CHARACTER (LEN=20) :: modname='cva_driver' 424 CHARACTER (LEN=80) :: abort_message 421 425 422 426 c … … 563 567 c test niveaux couche alimentation KE 564 568 if(sig1feed1.eq.sig2feed1) then 565 print*,'impossible de choisir sig1feed=sig2feed' 566 print*,'changer la valeur de sig2feed dans physiq.def' 567 stop 569 write(lunout,*)'impossible de choisir sig1feed=sig2feed' 570 write(lunout,*)'changer la valeur de sig2feed dans physiq.def' 571 abort_message = '' 572 CALL abort_gcm (modname,abort_message,1) 568 573 endif 569 574 c -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/fisrtilp.F
r1279 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 135 135 PRINT*, 'fisrtilp, evap_prec:', evap_prec 136 136 PRINT*, 'fisrtilp, cpartiel:', cpartiel 137 IF (ABS(dtime/ FLOAT(ninter)-360.0).GT.0.001) THEN137 IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN 138 138 PRINT*, 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime 139 139 PRINT*, 'Je prefere un sous-intervalle de 6 minutes' … … 436 436 zfice(i) = zfice(i)**nexpo 437 437 zneb(i) = MAX(rneb(i,k), seuil_neb) 438 radliq(i,k) = zoliq(i)/ FLOAT(ninter+1)438 radliq(i,k) = zoliq(i)/REAL(ninter+1) 439 439 ENDIF 440 440 ENDDO … … 453 453 zcl =cld_lc_con 454 454 zct =1./cld_tau_con 455 zfroi = dtime/ FLOAT(ninter)/zdz(i)*zoliq(i)455 zfroi = dtime/REAL(ninter)/zdz(i)*zoliq(i) 456 456 . *fallvc(zrhol(i)) * zfice(i) 457 457 else 458 458 zcl =cld_lc_lsc 459 459 zct =1./cld_tau_lsc 460 zfroi = dtime/ FLOAT(ninter)/zdz(i)*zoliq(i)460 zfroi = dtime/REAL(ninter)/zdz(i)*zoliq(i) 461 461 . *fallvs(zrhol(i)) * zfice(i) 462 462 endif 463 zchau = zct *dtime/ FLOAT(ninter) * zoliq(i)463 zchau = zct *dtime/REAL(ninter) * zoliq(i) 464 464 . *(1.0-EXP(-(zoliq(i)/zneb(i)/zcl )**2)) *(1.-zfice(i)) 465 465 ztot = zchau + zfroi … … 468 468 ztot = MIN(ztot,zoliq(i)) 469 469 zoliq(i) = MAX(zoliq(i)-ztot , 0.0) 470 radliq(i,k) = radliq(i,k) + zoliq(i)/ FLOAT(ninter+1)470 radliq(i,k) = radliq(i,k) + zoliq(i)/REAL(ninter+1) 471 471 ENDIF 472 472 ENDDO -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/fisrtilp_tr.F
r766 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 140 140 PRINT*, 'fisrtilp, evap_prec:', evap_prec 141 141 PRINT*, 'fisrtilp, cpartiel:', cpartiel 142 IF (ABS(dtime/ FLOAT(ninter)-360.0).GT.0.001) THEN142 IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN 143 143 PRINT*, 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime 144 144 PRINT*, 'Je prefere un sous-intervalle de 6 minutes' … … 335 335 zfice(i) = zfice(i)**nexpo 336 336 zneb(i) = MAX(rneb(i,k), seuil_neb) 337 radliq(i,k) = zoliq(i)/ FLOAT(ninter+1)337 radliq(i,k) = zoliq(i)/REAL(ninter+1) 338 338 ENDIF 339 339 ENDDO … … 342 342 DO i = 1, klon 343 343 IF (rneb(i,k).GT.0.0) THEN 344 zchau(i) = ct*dtime/ FLOAT(ninter) * zoliq(i)344 zchau(i) = ct*dtime/REAL(ninter) * zoliq(i) 345 345 . * (1.0-EXP(-(zoliq(i)/zneb(i)/cl)**2)) *(1.-zfice(i)) 346 346 zrhol(i) = zrho(i) * zoliq(i) / zneb(i) 347 zfroi(i) = dtime/ FLOAT(ninter)/zdz(i)*zoliq(i)347 zfroi(i) = dtime/REAL(ninter)/zdz(i)*zoliq(i) 348 348 . *fallv(zrhol(i)) * zfice(i) 349 349 ztot(i) = zchau(i) + zfroi(i) … … 351 351 ztot(i) = MIN(MAX(ztot(i),0.0),zoliq(i)) 352 352 zoliq(i) = MAX(zoliq(i)-ztot(i), 0.0) 353 radliq(i,k) = radliq(i,k) + zoliq(i)/ FLOAT(ninter+1)353 radliq(i,k) = radliq(i,k) + zoliq(i)/REAL(ninter+1) 354 354 ENDIF 355 355 ENDDO -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/hines_gwd.F
r1279 r1299 847 847 C Use horizontal isotropy to calculate azimuthal variances at bottom level. 848 848 C 849 AZFAC = 1. / FLOAT(NAZ)849 AZFAC = 1. / REAL(NAZ) 850 850 DO 20 N = 1,NAZ 851 851 DO 10 I = IL1,IL2 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/ini_bilKP_ave.h
r766 r1299 1 1 c 2 c $ Header$2 c $Id$ 3 3 c 4 4 IF (ok_journe) THEN … … 17 17 cym ENDDO 18 18 DO ll=1,klev 19 znivsig(ll)= float(ll)19 znivsig(ll)=REAL(ll) 20 20 ENDDO 21 21 cym CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/ini_bilKP_ins.h
r766 r1299 1 1 c 2 c $ Header$2 c $Id$ 3 3 c 4 4 IF (ok_journe) THEN … … 17 17 cym ENDDO 18 18 DO ll=1,klev 19 znivsig(ll)= float(ll)19 znivsig(ll)=REAL(ll) 20 20 ENDDO 21 21 cym CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/ini_histISCCP.h
r1045 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 IF (ok_isccp) THEN … … 49 49 c 50 50 DO l=1, ncol(n) 51 vertlev(l,n)= float(l)51 vertlev(l,n)=REAL(l) 52 52 ENDDO !ncol 53 53 c -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/ini_histday_seri.h
r776 r1299 1 1 c 2 c $ Header$2 c $Id$ 3 3 c 4 4 cym Ne fonctionnera pas en mode parallele … … 19 19 ENDDO 20 20 DO ll=1,klev 21 znivsig(ll)= float(ll)21 znivsig(ll)=REAL(ll) 22 22 ENDDO 23 23 CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/ini_histmthNMC.h
r776 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 IF (ok_mensuel) THEN … … 20 20 cym ENDDO 21 21 DO ll=1,klev 22 znivsig(ll)= float(ll)22 znivsig(ll)=REAL(ll) 23 23 ENDDO 24 24 cym CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/inifis.F
r987 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE inifis(ngrid,nlayer, … … 45 45 cym#include "dimphy.h" 46 46 47 INCLUDE 'iniprint.h' 47 48 REAL prad,pg,pr,pcpp,punjours 48 49 … … 52 53 53 54 REAL ptimestep 55 CHARACTER (LEN=20) :: modname='inifis' 56 CHARACTER (LEN=80) :: abort_message 57 54 58 55 59 IF (nlayer.NE.klev) THEN … … 58 62 PRINT*,'nlayer = ',nlayer 59 63 PRINT*,'klev = ',klev 60 STOP 64 abort_message = '' 65 CALL abort_gcm (modname,abort_message,1) 61 66 ENDIF 62 67 … … 66 71 PRINT*,'ngrid = ',ngrid 67 72 PRINT*,'klon = ',klon 68 STOP 73 abort_message = '' 74 CALL abort_gcm (modname,abort_message,1) 69 75 ENDIF 70 76 71 77 RETURN 72 9999 STOP'Cette version demande les fichier rnatur.dat et surf.def' 78 9999 continue 79 abort_message = 'Cette version demande les fichier rnatur.dat 80 & et surf.def' 81 CALL abort_gcm (modname,abort_message,1) 82 73 83 END -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/iniphysiq.F
r879 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 61 61 62 62 REAL ptimestep 63 CHARACTER (LEN=20) :: modname='iniphysiq' 64 CHARACTER (LEN=80) :: abort_message 63 65 64 66 IF (nlayer.NE.klev) THEN … … 67 69 PRINT*,'nlayer = ',nlayer 68 70 PRINT*,'klev = ',klev 69 STOP 71 abort_message = '' 72 CALL abort_gcm (modname,abort_message,1) 70 73 ENDIF 71 74 … … 75 78 PRINT*,'ngrid = ',ngrid 76 79 PRINT*,'klon = ',klon_glo 77 STOP 80 abort_message = '' 81 CALL abort_gcm (modname,abort_message,1) 78 82 ENDIF 79 83 c$OMP PARALLEL PRIVATE(ibegin,iend) … … 96 100 97 101 RETURN 98 9999 STOP'Cette version demande les fichier rnatur.dat et surf.def' 102 9999 CONTINUE 103 abort_message ='Cette version demande les fichier rnatur.dat 104 & et surf.def' 105 CALL abort_gcm (modname,abort_message,1) 106 99 107 END -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/initphysto.F
r1279 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 C … … 12 12 USE IOIPSL 13 13 USE iophy 14 USE control_mod 15 14 16 implicit none 15 17 … … 52 54 #include "serre.h" 53 55 #include "indicesol.h" 54 #include "control.h"55 56 cym#include "dimphy.h" 56 57 … … 108 109 C 109 110 DO l=1,llm 110 nivsigs(l)= float(l)111 nivsigs(l)=REAL(l) 111 112 ENDDO 112 113 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/initrrnpb.F90
r1279 r1299 1 1 ! 2 ! $Id 2 ! $Id$ 3 3 ! 4 4 SUBROUTINE initrrnpb(ftsol,pctsrf,masktr,fshtr,hsoltr,tautr,vdeptr,scavtr) … … 39 39 REAL :: s 40 40 41 CHARACTER (LEN=20) :: modname='initrrnpb' 42 CHARACTER (LEN=80) :: abort_message 43 44 41 45 WRITE(*,*)'PASSAGE initrrnpb ...' 42 46 ! 43 47 ! Radon it = 1 44 48 !---------------- 45 IF ( nbtr .LE. 0 ) STOP '**PHYTRAC:initrrnpb:** nbtr < 0; verifier RN dans traceur.def' 49 IF ( nbtr .LE. 0 ) then 50 abort_message = '**PHYTRAC:initrrnpb:** nbtr < 0; verifier RN dans traceur.def' 51 CALL abort_gcm (modname,abort_message,1) 52 ENDIF 46 53 it = 1 47 54 s = 1.E4 ! Source: atome par m2 … … 68 75 ! 210Pb it = 2 69 76 !---------------- 70 IF ( nbtr .LE. 1 ) STOP '**PHYTRAC**:initrrnpb:** nbtr <= 1; verifier PB dans traceur.def' 77 IF ( nbtr .LE. 1 ) THEN 78 abort_message='**PHYTRAC**:initrrnpb:** nbtr <= 1; verifier PB dans traceur.def' 79 CALL abort_gcm (modname,abort_message,1) 80 ENDIF 71 81 it = 2 72 82 s = 0. ! Pas de source -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/mod_phys_lmdz_omp_data.F90
r1001 r1299 1 1 ! 2 !$ Header$2 !$Id$ 3 3 ! 4 4 MODULE mod_phys_lmdz_omp_data … … 27 27 INTEGER :: i 28 28 29 CHARACTER (LEN=20) :: modname='Init_phys_lmdz_omp_data' 30 CHARACTER (LEN=80) :: abort_message 31 32 29 33 #ifdef CPP_OMP 30 34 INTEGER :: OMP_GET_NUM_THREADS … … 51 55 is_omp_root=.TRUE. 52 56 ELSE 53 PRINT *,'ANORMAL : OMP_MASTER /= 0'54 STOP57 abort_message = 'ANORMAL : OMP_MASTER /= 0' 58 CALL abort_gcm (modname,abort_message,1) 55 59 ENDIF 56 60 !$OMP END MASTER -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/o3cm.F
r524 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE o3cm (amb, bmb, sortie, ntab) … … 19 19 c====================================================================== 20 20 external mbtozm 21 CHARACTER (LEN=20) :: modname='' 22 CHARACTER (LEN=80) :: abort_message 21 23 c====================================================================== 22 24 c la fonction en ligne w(x) donne le profil de l'ozone en fonction … … 27 29 w(x) = wp/h * EXP((x-xp)/h)/ (con+EXP((x-xp)/h))**2 28 30 c====================================================================== 29 IF (ntab .GT. 499) STOP 'BIG ntab' 30 xincr = (bmb-amb) / FLOAT(ntab) 31 IF (ntab .GT. 499) THEN 32 abort_message = 'BIG ntab' 33 CALL abort_gcm (modname,abort_message,1) 34 ENDIF 35 xincr = (bmb-amb) / REAL(ntab) 31 36 xtab(1) = amb 32 37 DO n = 2, ntab -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/orografi.F
r1279 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE drag_noro (nlon,nlev,dtime,paprs,pplay, … … 1497 1497 * ZDVDT(KLON) 1498 1498 REAL ZHCRIT(KLON,KLEV) 1499 CHARACTER (LEN=20) :: modname='orografi' 1500 CHARACTER (LEN=80) :: abort_message 1499 1501 C----------------------------------------------------------------------- 1500 1502 C … … 1504 1506 LIFTHIGH=.FALSE. 1505 1507 1506 IF(NLON.NE.KLON.OR.NLEV.NE.KLEV)STOP 1508 IF(NLON.NE.KLON.OR.NLEV.NE.KLEV)THEN 1509 abort_message = 'pb dimension' 1510 CALL abort_gcm (modname,abort_message,1) 1511 ENDIF 1507 1512 ZCONS1=1./RD 1508 1513 cym KLEVM1=KLEV-1 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/orografi_strato.F
r1001 r1299 89 89 REAL pt(klon,klev), pu(klon,klev), pv(klon,klev) 90 90 REAL papmf(klon,klev),papmh(klon,klev+1) 91 CHARACTER (LEN=20) :: modname='orografi_strato' 92 CHARACTER (LEN=80) :: abort_message 91 93 c 92 94 c INITIALIZE OUTPUT VARIABLES … … 1680 1682 logical lifthigh 1681 1683 real zcons1,ztmst 1684 CHARACTER (LEN=20) :: modname='orolift_strato' 1685 CHARACTER (LEN=80) :: abort_message 1686 1682 1687 1683 1688 C----------------------------------------------------------------------- … … 1688 1693 lifthigh=.false. 1689 1694 1690 if(nlon.ne.klon.or.nlev.ne.klev)stop 1695 if(nlon.ne.klon.or.nlev.ne.klev) then 1696 abort_message = 'pb dimension' 1697 CALL abort_gcm (modname,abort_message,1) 1698 ENDIF 1691 1699 zcons1=1./rd 1692 1700 ztmst=ptsphy -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/pbl_surface_mod.F90
r1282 r1299 22 22 USE climb_wind_mod, ONLY : climb_wind_down, climb_wind_up 23 23 USE coef_diff_turb_mod, ONLY : coef_diff_turb 24 USE control_mod 25 24 26 25 27 IMPLICIT NONE … … 257 259 INCLUDE "YOETHF.h" 258 260 INCLUDE "temps.h" 259 INCLUDE "control.h"260 261 ! Input variables 261 262 !**************************************************************************************** … … 657 658 tabindx(:)=0. 658 659 DO i=1,knon 659 tabindx(i)= FLOAT(i)660 tabindx(i)=REAL(i) 660 661 END DO 661 662 debugtab(:,:) = 0. -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/phyredem.F
r1298 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 14 14 USE traclmdz_mod, ONLY : traclmdz_to_restart 15 15 USE infotrac 16 USE control_mod 17 16 18 17 19 IMPLICIT none … … 24 26 #include "dimsoil.h" 25 27 #include "clesphys.h" 26 #include "control.h"27 28 #include "temps.h" 28 29 #include "thermcell.h" -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/phys_state_var_mod.F90
r1279 r1299 289 289 SUBROUTINE phys_state_var_init(read_climoz) 290 290 use dimphy 291 USE control_mod 291 292 use aero_mod 292 293 IMPLICIT NONE … … 301 302 302 303 #include "indicesol.h" 303 #include "control.h"304 304 ALLOCATE(rlat(klon), rlon(klon)) 305 305 ALLOCATE(pctsrf(klon,nbsrf)) … … 411 411 SUBROUTINE phys_state_var_end 412 412 use dimphy 413 use control_mod 413 414 IMPLICIT NONE 414 415 #include "indicesol.h" 415 #include "control.h"416 416 417 417 deallocate(rlat, rlon, pctsrf, ftsol, falb1, falb2) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/physiq.F
r1298 r1299 39 39 use conf_phys_m, only: conf_phys 40 40 use radlwsw_m, only: radlwsw 41 USE control_mod 42 41 43 42 44 IMPLICIT none … … 97 99 #include "dimsoil.h" 98 100 #include "clesphys.h" 99 #include "control.h"100 101 #include "temps.h" 101 102 #include "iniprint.h" … … 1348 1349 ENDIF 1349 1350 c 1350 IF (dtime* FLOAT(radpas).GT.21600..AND.cycle_diurne) THEN1351 IF (dtime*REAL(radpas).GT.21600..AND.cycle_diurne) THEN 1351 1352 WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant' 1352 1353 WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne" … … 1518 1519 CALL VTb(VTinca) 1519 1520 ! iii = MOD(NINT(xjour),360) 1520 ! calday = FLOAT(iii) + jH_cur1521 calday = FLOAT(days_elapsed) + jH_cur1521 ! calday = REAL(iii) + jH_cur 1522 calday = REAL(days_elapsed) + jH_cur 1522 1523 WRITE(lunout,*) 'initial time chemini', days_elapsed, calday 1523 1524 … … 1801 1802 ! solarlong0 1802 1803 if (solarlong0<-999.) then 1803 CALL orbite( FLOAT(days_elapsed+1),zlongi,dist)1804 CALL orbite(REAL(days_elapsed+1),zlongi,dist) 1804 1805 else 1805 1806 zlongi=solarlong0 ! longitude solaire vraie … … 1812 1813 ! Avec ou sans cycle diurne 1813 1814 IF (cycle_diurne) THEN 1814 zdtime=dtime* FLOAT(radpas) ! pas de temps du rayonnement (s)1815 zdtime=dtime*REAL(radpas) ! pas de temps du rayonnement (s) 1815 1816 CALL zenang(zlongi,jH_cur,zdtime,rlat,rlon,rmu0,fract) 1816 1817 ELSE … … 1961 1962 1962 1963 IF (iflag_con.EQ.1) THEN 1963 stop'reactiver le call conlmd dans physiq.F' 1964 abort_message ='reactiver le call conlmd dans physiq.F' 1965 CALL abort_gcm (modname,abort_message,1) 1964 1966 c CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q, 1965 1967 c . d_t_con, d_q_con, … … 2205 2207 za = 0.0 2206 2208 DO i = 1, klon 2207 za = za + airephy(i)/ FLOAT(klon)2209 za = za + airephy(i)/REAL(klon) 2208 2210 zx_t = zx_t + (rain_con(i)+ 2209 . snow_con(i))*airephy(i)/ FLOAT(klon)2211 . snow_con(i))*airephy(i)/REAL(klon) 2210 2212 ENDDO 2211 2213 zx_t = zx_t/za*dtime … … 2599 2601 za = 0.0 2600 2602 DO i = 1, klon 2601 za = za + airephy(i)/ FLOAT(klon)2603 za = za + airephy(i)/REAL(klon) 2602 2604 zx_t = zx_t + (rain_lsc(i) 2603 . + snow_lsc(i))*airephy(i)/ FLOAT(klon)2605 . + snow_lsc(i))*airephy(i)/REAL(klon) 2604 2606 ENDDO 2605 2607 zx_t = zx_t/za*dtime … … 2823 2825 CALL VTe(VTphysiq) 2824 2826 CALL VTb(VTinca) 2825 calday = FLOAT(days_elapsed + 1) + jH_cur2827 calday = REAL(days_elapsed + 1) + jH_cur 2826 2828 2827 2829 call chemtime(itap+itau_phy-1, date0, dtime) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/phystokenc.F
r1146 r1299 13 13 USE infotrac, ONLY : nqtot 14 14 USE iophy 15 USE control_mod 16 15 17 IMPLICIT none 16 18 … … 24 26 #include "tracstoke.h" 25 27 #include "indicesol.h" 26 #include "control.h"27 28 c====================================================================== 28 29 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/phytrac.F90
r1279 r1299 33 33 USE traclmdz_mod 34 34 USE tracinca_mod 35 USE control_mod 36 35 37 36 38 … … 43 45 INCLUDE "temps.h" 44 46 INCLUDE "paramet.h" 45 INCLUDE "control.h"46 47 INCLUDE "thermcell.h" 47 48 !========================================================================== -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/read_pstoke.F
r1146 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 18 18 C****************************************************************************** 19 19 20 use netcdf 21 USE dimphy 20 use netcdf 21 USE dimphy 22 USE control_mod 23 22 24 IMPLICIT NONE 23 25 … … 33 35 #include "serre.h" 34 36 #include "indicesol.h" 35 #include "control.h"36 37 cccc#include "dimphy.h" 37 38 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/read_pstoke0.F
r1146 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 c … … 19 19 use netcdf 20 20 USE dimphy 21 USE control_mod 22 21 23 IMPLICIT NONE 22 24 … … 32 34 #include "serre.h" 33 35 #include "indicesol.h" 34 #include "control.h"35 36 cccc#include "dimphy.h" 36 37 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/readaerosol.F90
r1279 r1299 128 128 DO i = 1, klon 129 129 pt_out(i,k,it) = & 130 pt_out(i,k,it) - FLOAT(iyr_in-iyr1)/FLOAT(iyr2-iyr1) * &130 pt_out(i,k,it) - REAL(iyr_in-iyr1)/REAL(iyr2-iyr1) * & 131 131 (pt_out(i,k,it) - pt_2(i,k,it)) 132 132 END DO … … 135 135 DO i = 1, klon 136 136 psurf(i,it) = & 137 psurf(i,it) - FLOAT(iyr_in-iyr1)/FLOAT(iyr2-iyr1) * &137 psurf(i,it) - REAL(iyr_in-iyr1)/REAL(iyr2-iyr1) * & 138 138 (psurf(i,it) - psurf2(i,it)) 139 139 140 140 load(i,it) = & 141 load(i,it) - FLOAT(iyr_in-iyr1)/FLOAT(iyr2-iyr1) * &141 load(i,it) - REAL(iyr_in-iyr1)/REAL(iyr2-iyr1) * & 142 142 (load(i,it) - load2(i,it)) 143 143 END DO … … 493 493 spole = spole + varyear(i,jjm+1,k,imth) 494 494 END DO 495 npole = npole/ FLOAT(iim)496 spole = spole/ FLOAT(iim)495 npole = npole/REAL(iim) 496 spole = spole/REAL(iim) 497 497 varyear(:,1, k,imth) = npole 498 498 varyear(:,jjm+1,k,imth) = spole -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/readaerosol_interp.F90
r1279 r1299 126 126 IF(mpi_rank == 0 .AND. debug)then 127 127 ! 0.02 is about 0.5/24, namly less than half an hour 128 OLDNEWDAY = (r_day- FLOAT(iday) < 0.02)128 OLDNEWDAY = (r_day-REAL(iday) < 0.02) 129 129 ! Once per day, update aerosol fields 130 130 lmt_pas = NINT(86400./pdtphys) 131 PRINT*,'r_day- FLOAT(iday) =',r_day-FLOAT(iday)131 PRINT*,'r_day-REAL(iday) =',r_day-REAL(iday) 132 132 PRINT*,'itap =',itap 133 133 PRINT*,'pdtphys =',pdtphys … … 233 233 ! 234 234 DO i = 2, 13 235 month_len(i) = float(ioget_mon_len(year_cur, i-1))235 month_len(i) = REAL(ioget_mon_len(year_cur, i-1)) 236 236 CALL ymds2ju(year_cur, i-1, 1, 0.0, month_start(i)) 237 237 ENDDO 238 month_len(1) = float(ioget_mon_len(year_cur-1, 12))238 month_len(1) = REAL(ioget_mon_len(year_cur-1, 12)) 239 239 CALL ymds2ju(year_cur-1, 12, 1, 0.0, month_start(1)) 240 month_len(14) = float(ioget_mon_len(year_cur+1, 1))240 month_len(14) = REAL(ioget_mon_len(year_cur+1, 1)) 241 241 CALL ymds2ju(year_cur+1, 1, 1, 0.0, month_start(14)) 242 242 month_mid(:) = month_start (:) + month_len(:)/2. -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/surf_ocean_mod.F90
r1146 r1299 141 141 !**************************************************************************************** 142 142 IF ( MINVAL(rmu0) == MAXVAL(rmu0) .AND. MINVAL(rmu0) == -999.999 ) THEN 143 CALL alboc( FLOAT(jour),rlat,alb_eau)143 CALL alboc(REAL(jour),rlat,alb_eau) 144 144 ELSE ! diurnal cycle 145 145 CALL alboc_cd(rmu0,alb_eau) -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/sw_aeroAR4.F90
r1279 r1299 186 186 !$OMP THREADPRIVATE(AEROSOLFEEDBACK_ACTIVE) 187 187 188 CHARACTER (LEN=20) :: modname='sw_aeroAR4' 189 CHARACTER (LEN=80) :: abort_message 190 188 191 IF ((.not. ok_ade) .and. (AEROSOLFEEDBACK_ACTIVE .ge. 2)) THEN 189 print*,'Error: direct effect is not activated but assumed to be active - see sw_aeroAR4.F90'190 stop192 abort_message ='Error: direct effect is not activated but assumed to be active - see sw_aeroAR4.F90' 193 CALL abort_gcm (modname,abort_message,1) 191 194 ENDIF 192 195 AEROSOLFEEDBACK_ACTIVE=MIN(MAX(AEROSOLFEEDBACK_ACTIVE,0),3) 193 196 IF (AEROSOLFEEDBACK_ACTIVE .gt. 3) THEN 194 print*,'Error: AEROSOLFEEDBACK_ACTIVE options go only until 3'195 stop197 abort_message ='Error: AEROSOLFEEDBACK_ACTIVE options go only until 3' 198 CALL abort_gcm (modname,abort_message,1) 196 199 ENDIF 197 200 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell.F
r987 r1299 1 ! 2 ! $Id$ 3 ! 1 4 SUBROUTINE calcul_sec(ngrid,nlay,ptimestep 2 5 s ,pplay,pplev,pphi,zlev … … 132 135 character*10 str10 133 136 137 character (len=20) :: modname='calcul_sec' 138 character (len=80) :: abort_message 139 140 134 141 ! LOGICAL vtest(klon),down 135 142 … … 530 537 c write(8,*)zmax(ig),lmax(ig),lentr(ig),lmin(ig) 531 538 enddo 532 con stop pe après les calculs de zmax et wmax539 con stope après les calculs de zmax et wmax 533 540 RETURN 534 541 … … 776 783 do ig=1,ngrid 777 784 if(fracd(ig,l).lt.0.1) then 778 stop'fracd trop petit' 785 abort_message = 'fracd trop petit' 786 CALL abort_gcm (modname,abort_message,1) 787 779 788 else 780 789 c vitesse descendante "diagnostique" … … 860 869 cRC 861 870 if (w2di.eq.1) then 862 fm0=fm0+ptimestep*(fm-fm0)/ float(tho)863 entr0=entr0+ptimestep*(entr-entr0)/ float(tho)871 fm0=fm0+ptimestep*(fm-fm0)/REAL(tho) 872 entr0=entr0+ptimestep*(entr-entr0)/REAL(tho) 864 873 else 865 874 fm0=fm -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcellV0_main.F90
r1294 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE thermcellV0_main(itap,ngrid,nlay,ptimestep & … … 165 165 character*2 str2 166 166 character*10 str10 167 168 character (len=20) :: modname='thermcellV0_main' 169 character (len=80) :: abort_message 167 170 168 171 EXTERNAL SCOPY … … 484 487 ! Test valable seulement en 1D mais pas genant 485 488 if (.not. (f0(1).ge.0.) ) then 486 stop 'Dans thermcell_main' 489 abort_message = 'Dans thermcell_main f0(1).lt.0 ' 490 CALL abort_gcm (modname,abort_message,1) 487 491 endif 488 492 … … 827 831 write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*po(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k) 828 832 enddo 829 ! stop830 833 endif 831 834 enddo … … 863 866 864 867 REAL f(ngrid) 868 869 character (len=20) :: modname='thermcellV0_main' 870 character (len=80) :: abort_message 865 871 866 872 do ig=1,ngrid … … 885 891 print*,'zmax_sec',zmax_sec(ig) 886 892 print*,'wmax_sec',wmax_sec(ig) 887 stop 893 abort_message = 'zdenom<1.e-14' 894 CALL abort_gcm (modname,abort_message,1) 888 895 endif 889 896 if ((zmax_sec(ig).gt.1.e-10).and.(iflag_thermals_ed.eq.0)) then … … 1338 1345 ! if(detr_star(ig,l).GT.1.) THEN 1339 1346 ! print*,'th_plumeAFT ig l detr_star f0 1/f0',ig,l,detr_star(ig,l),f0(ig), & 1340 ! & float(1)/f0(ig)1347 ! & REAL(1)/f0(ig) 1341 1348 ! endif 1342 1349 !IM 060508 end … … 1656 1663 1657 1664 if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then 1658 ! stop'On tombe sur le cas particulier de thermcell_dry'1659 1665 print*,'On tombe sur le cas particulier de thermcell_plume' 1660 1666 zw2(ig,l+1)=0. … … 1832 1838 1833 1839 if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then 1834 ! stop'On tombe sur le cas particulier de thermcell_dry'1835 1840 ! print*,'On tombe sur le cas particulier de thermcell_dry' 1836 1841 zw2(ig,l+1)=0. -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_dq.F90
r983 r1299 31 31 real ztimestep 32 32 integer niter,iter 33 CHARACTER (LEN=20) :: modname='thermcell_dq' 34 CHARACTER (LEN=80) :: abort_message 33 35 34 36 … … 42 44 if (entr(ig,k).gt.zzm) then 43 45 print*,'entr dt > m ',entr(ig,k)*ptimestep,masse(ig,k) 44 stop 46 abort_message = '' 47 CALL abort_gcm (modname,abort_message,1) 45 48 endif 46 49 enddo -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_dry.F90
r1294 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star, & … … 39 39 REAL linter(ngrid),zlevinter(ngrid) 40 40 INTEGER lmix(ngrid),lmax(ngrid),lmin(ngrid) 41 CHARACTER (LEN=20) :: modname='thermcell_dry' 42 CHARACTER (LEN=80) :: abort_message 41 43 42 44 !initialisations -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_flux.F90
r1146 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 … … 51 51 !$OMP THREADPRIVATE(fomass_max,alphamax) 52 52 53 character (len=20) :: modname='thermcell_flux' 54 character (len=80) :: abort_message 55 53 56 fomass_max=0.5 54 57 alphamax=0.7 … … 92 95 print*,'alim_star(ig,l)',alim_star(ig,l) 93 96 print*,'detr_star(ig,l)',detr_star(ig,l) 94 ! stop95 97 endif 96 98 else … … 100 102 print*,'alim_star(ig,l)',alim_star(ig,l) 101 103 print*,'detr_star(ig,l)',detr_star(ig,l) 102 stop 104 abort_message = '' 105 CALL abort_gcm (modname,abort_message,1) 103 106 endif 104 107 endif … … 264 267 if (entr(ig,l)<0.) then 265 268 print*,'N1 ig,l,entr',ig,l,entr(ig,l) 266 stop 'entr negatif' 269 abort_message = 'entr negatif' 270 CALL abort_gcm (modname,abort_message,1) 267 271 endif 268 272 if (detr(ig,l).gt.fm(ig,l)) then … … 292 296 print*,'entr(ig,l)',entr(ig,l) 293 297 print*,'fm(ig,l)',fm(ig,l) 294 stop 'probleme dans thermcell flux' 298 abort_message = 'probleme dans thermcell flux' 299 CALL abort_gcm (modname,abort_message,1) 295 300 endif 296 301 enddo … … 319 324 print*,'detr(ig,l)',detr(ig,l) 320 325 print*,'fm(ig,l)',fm(ig,l) 321 stop 'probleme dans thermcell flux' 326 abort_message = 'probleme dans thermcell flux' 327 CALL abort_gcm (modname,abort_message,1) 322 328 endif 323 329 enddo … … 420 426 print*,'fm(ig,l+1)',fm(ig,l+1) 421 427 print*,'fm(ig,l)',fm(ig,l) 422 stop 'probleme dans thermcell_flux' 428 abort_message = 'probleme dans thermcell_flux' 429 CALL abort_gcm (modname,abort_message,1) 423 430 endif 424 431 entr(ig,l+1)=entr(ig,l+1)-ddd … … 478 485 character*3 descr 479 486 487 character (len=20) :: modname='thermcell_flux' 488 character (len=80) :: abort_message 489 480 490 lm=lmax(igout)+5 481 491 if(lm.gt.klev) lm=klev … … 500 510 print*,'detr(igout,l)',detr(igout,l) 501 511 print*,'fm(igout,l)',fm(igout,l) 502 stop 512 abort_message = '' 513 CALL abort_gcm (modname,abort_message,1) 503 514 endif 504 515 enddo -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_flux2.F90
r1146 r1299 1 ! 2 ! $Id$ 3 ! 1 4 SUBROUTINE thermcell_flux2(ngrid,klev,ptimestep,masse, & 2 5 & lalim,lmax,alim_star, & … … 47 50 save fomass_max,alphamax 48 51 52 character (len=20) :: modname='thermcell_flux2' 53 character (len=80) :: abort_message 54 49 55 fomass_max=0.5 50 56 alphamax=0.7 … … 88 94 print*,'alim_star(ig,l)',alim_star(ig,l) 89 95 print*,'detr_star(ig,l)',detr_star(ig,l) 90 ! stop91 96 endif 92 97 else … … 96 101 print*,'alim_star(ig,l)',alim_star(ig,l) 97 102 print*,'detr_star(ig,l)',detr_star(ig,l) 98 stop 103 abort_message = '' 104 CALL abort_gcm (modname,abort_message,1) 99 105 endif 100 106 endif … … 256 262 if (entr(ig,l)<0.) then 257 263 print*,'N1 ig,l,entr',ig,l,entr(ig,l) 258 stop 'entr negatif' 264 abort_message = 'entr negatif' 265 CALL abort_gcm (modname,abort_message,1) 259 266 endif 260 267 if (detr(ig,l).gt.fm(ig,l)) then … … 285 292 print*,'entr(ig,l)',entr(ig,l) 286 293 print*,'fm(ig,l)',fm(ig,l) 287 stop 'probleme dans thermcell flux' 294 abort_message = 'probleme dans thermcell flux' 295 CALL abort_gcm (modname,abort_message,1) 288 296 endif 289 297 enddo … … 312 320 print*,'detr(ig,l)',detr(ig,l) 313 321 print*,'fm(ig,l)',fm(ig,l) 314 stop 'probleme dans thermcell flux' 322 abort_message = 'probleme dans thermcell flux' 323 CALL abort_gcm (modname,abort_message,1) 315 324 endif 316 325 enddo … … 413 422 print*,'fm(ig,l+1)',fm(ig,l+1) 414 423 print*,'fm(ig,l)',fm(ig,l) 415 stop 'probleme dans thermcell_flux' 424 abort_message = 'probleme dans thermcell_flux' 425 CALL abort_gcm (modname,abort_message,1) 416 426 endif 417 427 entr(ig,l+1)=entr(ig,l+1)-ddd -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_main.F90
r1294 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE thermcell_main(itap,ngrid,nlay,ptimestep & … … 170 170 character*2 str2 171 171 character*10 str10 172 173 character (len=20) :: modname='thermcell_main' 174 character (len=80) :: abort_message 172 175 173 176 EXTERNAL SCOPY … … 466 469 ! Test valable seulement en 1D mais pas genant 467 470 if (.not. (f0(1).ge.0.) ) then 468 stop'Dans thermcell_main' 471 abort_message = '.not. (f0(1).ge.0.)' 472 CALL abort_gcm (modname,abort_message,1) 469 473 endif 470 474 … … 781 785 if (prt_level.ge.1) print*,'thermcell_main FIN OK' 782 786 783 ! if(icount.eq.501) stop'au pas 301 dans thermcell_main'784 787 return 785 788 end … … 817 820 write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*po(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k) 818 821 enddo 819 ! stop820 822 endif 821 823 enddo -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_old.F
r987 r1299 112 112 character (len=10) :: str10 113 113 114 character (len=20) :: modname='thermcell2002' 115 character (len=80) :: abort_message 116 114 117 LOGICAL vtest(klon),down 115 118 … … 336 339 if(w2di.eq.2) then 337 340 entr(ig,k)=entr(ig,k)+ 338 s ptimestep*(zzz-entr(ig,k))/ float(tho)341 s ptimestep*(zzz-entr(ig,k))/REAL(tho) 339 342 else 340 343 entr(ig,k)=zzz … … 379 382 c print*,'ig,l+1,ztv(ig,l+1)' 380 383 c print*, ig,l+1,ztv(ig,l+1) 381 c stop'dans thermiques'382 384 c endif 383 385 zw2(ig,l+1)=2.*RG*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig,l+1) … … 395 397 c print*,'Tv ',(ztv(ig,ll),ll=1,klev) 396 398 c print*,'Entr ',(entr(ig,ll),ll=1,klev) 397 c stop'dans thermiques'398 399 c endif 399 400 ztva(ig,l)=(fmc(ig,l)*ztva(ig,l-1)+entr(ig,l)*ztv(ig,l)) … … 517 518 do ig=1,ngrid 518 519 if(fracd(ig,l).lt.0.1) then 519 stop'fracd trop petit' 520 else 520 abort_message = 'fracd trop petit' 521 CALL abort_gcm (modname,abort_message,1) 522 else 521 523 c vitesse descendante "diagnostique" 522 524 wd(ig,l)=fm(ig,l)/(fracd(ig,l)*rhobarz(ig,l)) … … 588 590 589 591 if (w2di.eq.1) then 590 fm0=fm0+ptimestep*(fm-fm0)/ float(tho)591 entr0=entr0+ptimestep*(entr-entr0)/ float(tho)592 fm0=fm0+ptimestep*(fm-fm0)/REAL(tho) 593 entr0=entr0+ptimestep*(entr-entr0)/REAL(tho) 592 594 else 593 595 fm0=fm … … 1000 1002 character*2 str2 1001 1003 character*10 str10 1004 1005 character (len=20) :: modname='thermcell_cld' 1006 character (len=80) :: abort_message 1002 1007 1003 1008 LOGICAL vtest(klon),down … … 1855 1860 if (l.eq.klev) then 1856 1861 print*,'THERMCELL PB ig=',ig,' l=',l 1857 stop 1862 abort_message = 'THERMCELL PB' 1863 CALL abort_gcm (modname,abort_message,1) 1858 1864 endif 1859 1865 ! if ((zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10).and. … … 2164 2170 do ig=1,ngrid 2165 2171 if(fracd(ig,l).lt.0.1.and.(test(ig).eq.1)) then 2166 stop'fracd trop petit' 2172 abort_message = 'fracd trop petit' 2173 CALL abort_gcm (modname,abort_message,1) 2167 2174 else 2168 2175 c vitesse descendante "diagnostique" … … 2262 2269 2263 2270 if (w2di.eq.1) then 2264 fm0=fm0+ptimestep*(fm-fm0)/ float(tho)2265 entr0=entr0+ptimestep*(alim+entr-entr0)/ float(tho)2271 fm0=fm0+ptimestep*(fm-fm0)/REAL(tho) 2272 entr0=entr0+ptimestep*(alim+entr-entr0)/REAL(tho) 2266 2273 else 2267 2274 fm0=fm … … 2747 2754 character*10 str10 2748 2755 2756 character (len=20) :: modname='thermcell_eau' 2757 character (len=80) :: abort_message 2758 2749 2759 LOGICAL vtest(klon),down 2750 2760 LOGICAL Zsat(klon) … … 3410 3420 do ig=1,ngrid 3411 3421 if(fracd(ig,l).lt.0.1) then 3412 stop'fracd trop petit' 3422 abort_message = 'fracd trop petit' 3423 CALL abort_gcm (modname,abort_message,1) 3413 3424 else 3414 3425 c vitesse descendante "diagnostique" … … 3481 3492 3482 3493 if (w2di.eq.1) then 3483 fm0=fm0+ptimestep*(fm-fm0)/ float(tho)3484 entr0=entr0+ptimestep*(entr-entr0)/ float(tho)3494 fm0=fm0+ptimestep*(fm-fm0)/REAL(tho) 3495 entr0=entr0+ptimestep*(entr-entr0)/REAL(tho) 3485 3496 else 3486 3497 fm0=fm … … 3848 3859 character*10 str10 3849 3860 3861 character (len=20) :: modname='thermcell' 3862 character (len=80) :: abort_message 3863 3850 3864 LOGICAL vtest(klon),down 3851 3865 … … 4394 4408 do ig=1,ngrid 4395 4409 if(fracd(ig,l).lt.0.1) then 4396 stop'fracd trop petit' 4410 abort_message = 'fracd trop petit' 4411 CALL abort_gcm (modname,abort_message,1) 4397 4412 else 4398 4413 c vitesse descendante "diagnostique" … … 4477 4492 cRC 4478 4493 if (w2di.eq.1) then 4479 fm0=fm0+ptimestep*(fm-fm0)/ float(tho)4480 entr0=entr0+ptimestep*(entr-entr0)/ float(tho)4494 fm0=fm0+ptimestep*(fm-fm0)/REAL(tho) 4495 entr0=entr0+ptimestep*(entr-entr0)/REAL(tho) 4481 4496 else 4482 4497 fm0=fm … … 5257 5272 character*10 str10 5258 5273 5274 character (len=20) :: modname='thermcell_sec' 5275 character (len=80) :: abort_message 5276 5259 5277 LOGICAL vtest(klon),down 5260 5278 … … 5822 5840 do ig=1,ngrid 5823 5841 if(fracd(ig,l).lt.0.1) then 5824 stop'fracd trop petit' 5842 abort_message = 'fracd trop petit' 5843 CALL abort_gcm (modname,abort_message,1) 5825 5844 else 5826 5845 c vitesse descendante "diagnostique" … … 5905 5924 cRC 5906 5925 if (w2di.eq.1) then 5907 fm0=fm0+ptimestep*(fm-fm0)/ float(tho)5908 entr0=entr0+ptimestep*(entr-entr0)/ float(tho)5926 fm0=fm0+ptimestep*(fm-fm0)/REAL(tho) 5927 entr0=entr0+ptimestep*(entr-entr0)/REAL(tho) 5909 5928 else 5910 5929 fm0=fm -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_plume.F90
r1294 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE thermcell_plume(itap,ngrid,klev,ptimestep,ztv,zthl,po,zl,rhobarz, & … … 436 436 if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then 437 437 ! stop'On tombe sur le cas particulier de thermcell_dry' 438 print*,'On tombe sur le cas particulier de thermcell_plume' 438 write(lunout,*) & 439 & 'On tombe sur le cas particulier de thermcell_plume' 439 440 zw2(ig,l+1)=0. 440 441 linter(ig)=l+1 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/tracinca_mod.F90
r1279 r1299 45 45 USE vampir 46 46 USE comgeomphy 47 USE control_mod 48 47 49 48 50 IMPLICIT NONE 49 51 50 52 INCLUDE "indicesol.h" 51 INCLUDE "control.h"52 53 INCLUDE "dimensions.h" 53 54 INCLUDE "paramet.h" … … 125 126 CALL VTb(VTinca) 126 127 127 calday = FLOAT(julien) + gmtime128 calday = REAL(julien) + gmtime 128 129 ncsec = NINT (86400.*gmtime) 129 130 -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/undefSTD.F
r1279 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE undefSTD(nlevSTD,itap,tlevSTD, … … 13 13 c I. Musat : 09.2004 14 14 c 15 c Calcul * du nombre de pas de temps ( FLOAT(ecrit_XXX)-tnondef))15 c Calcul * du nombre de pas de temps (REAL(ecrit_XXX)-tnondef)) 16 16 c ou la variable tlevSTD est bien definie (.NE.1.E+20), 17 17 c et -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/write_histISCCP.h
r1045 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 IF (ok_isccp) THEN … … 77 77 . meantaucld(:,n)) 78 78 c 79 zx_tmp_fi2d(1:klon)= float(seed(1:klon,n))79 zx_tmp_fi2d(1:klon)=REAL(seed(1:klon,n)) 80 80 c 81 81 c print*,'n=',n,' write_ISCCP avant seed' -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/yamada4.F
r938 r1299 1 1 ! 2 ! $ Header$2 ! $Id$ 3 3 ! 4 4 SUBROUTINE yamada4(ngrid,dt,g,rconst,plev,temp … … 106 106 c$OMP THREADPRIVATE(rino,smyam,styam,lyam,knyam,w2yam,t2yam) 107 107 logical,save :: firstcall=.true. 108 109 character (len=20) :: modname='yamada4' 110 character (len=80) :: abort_message 111 108 112 c$OMP THREADPRIVATE(firstcall) 109 113 frif(ri)=0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156)) … … 128 132 129 133 if (.not.(iflag_pbl.ge.6.and.iflag_pbl.le.9)) then 130 stop'probleme de coherence dans appel a MY' 134 abort_message = 'probleme de coherence dans appel a MY' 135 CALL abort_gcm (modname,abort_message,1) 131 136 endif 132 137
Note: See TracChangeset
for help on using the changeset viewer.