Ignore:
Timestamp:
Nov 1, 2016, 8:41:01 AM (8 years ago)
Author:
oboucher
Message:

Adding a call to stratosphere_mask in the case of StratAer?.
A lot of cosmetic changes on if/endif do/enddo and calls

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/physiq_mod.F90

    r2690 r2692  
    10901090    ! en imposant la valeur de igout.
    10911091    !======================================================================d
    1092     if (prt_level.ge.1) then
     1092    IF (prt_level.ge.1) THEN
    10931093       igout=klon/2+1/klon
    10941094       write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
    … …  
    11011101
    11021102       write(lunout,*) 'paprs, play, phi, u, v, t'
    1103        do k=1,klev
     1103       DO k=1,klev
    11041104          write(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k), &
    11051105               u(igout,k),v(igout,k),t(igout,k)
    1106        enddo
     1106       ENDDO
    11071107       write(lunout,*) 'ovap (g/kg),  oliq (g/kg)'
    1108        do k=1,klev
     1108       DO k=1,klev
    11091109          write(lunout,*) qx(igout,k,1)*1000,qx(igout,k,2)*1000.
    1110        enddo
    1111     endif
     1110       ENDDO
     1111    ENDIF
    11121112
    11131113    !======================================================================
    11141114
    1115     if (first) then
     1115    IF (first) THEN
    11161116       !CR:nvelles variables convection/poches froides
    11171117
    11181118       print*, '================================================='
    11191119       print*, 'Allocation des variables locales et sauvegardees'
    1120        call phys_local_var_init
     1120       CALL phys_local_var_init
    11211121       !
    11221122       pasphys=pdtphys
    11231123       !     appel a la lecture du run.def physique
    1124        call conf_phys(ok_journe, ok_mensuel, &
     1124       CALL conf_phys(ok_journe, ok_mensuel, &
    11251125            ok_instan, ok_hf, &
    11261126            ok_LES, &
    … …  
    11361136            read_climoz, &
    11371137            alp_offset)
    1138        call phys_state_var_init(read_climoz)
    1139        call phys_output_var_init
     1138       CALL phys_state_var_init(read_climoz)
     1139       CALL phys_output_var_init
    11401140       print*, '================================================='
    11411141       !
    11421142       !CR: check sur le nb de traceurs de l eau
    1143        if ((iflag_ice_thermo.gt.0).and.(nqo==2)) then
     1143       IF ((iflag_ice_thermo.gt.0).and.(nqo==2)) THEN
    11441144          WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers ', &
    11451145               '(H2Ov, H2Ol, H2Oi) but nqo=', nqo, '. Might as well stop here.'
    11461146          STOP
    1147        endif
     1147       ENDIF
    11481148
    11491149       dnwd0=0.0
    … …  
    11581158       first=.false.
    11591159
    1160     endif  ! first
     1160    ENDIF  ! first
    11611161
    11621162    !ym => necessaire pour iflag_con != 2   
    … …  
    11801180       DO i=1,klon
    11811181          zero_v(i)=0.
    1182        END DO
    1183     END IF
     1182       ENDDO
     1183    ENDIF
    11841184
    11851185    IF (debut) THEN
    … …  
    11951195    ENDIF
    11961196
    1197     if(prt_level.ge.1) print*,'CONVERGENCE PHYSIQUE THERM 1 '
     1197    IF (prt_level.ge.1) print *,'CONVERGENCE PHYSIQUE THERM 1 '
    11981198
    11991199
    … …  
    12391239       ELSE
    12401240          config_inca='none' ! default
    1241        END IF
     1241       ENDIF
    12421242
    12431243       IF (aerosol_couple .AND. (config_inca /= "aero" &
    … …  
    12781278       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    12791279
    1280        if (iflag_pbl>1) then
     1280       IF (iflag_pbl>1) THEN
    12811281          PRINT*, "Using method MELLOR&YAMADA"
    1282        endif
     1282       ENDIF
    12831283
    12841284       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    12981298          abort_message='nbre de pas de temps physique n est pas multiple ' &
    12991299               // 'de nbapp_rad'
    1300           call abort_physic(modname,abort_message,1)
     1300          CALL abort_physic(modname,abort_message,1)
    13011301       ENDIF
    13021302       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    13201320
    13211321
    1322 
    13231322       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    13241323       !
    … …  
    13431342               klon
    13441343          abort_message='nlon et klon ne sont pas coherents'
    1345           call abort_physic(modname,abort_message,1)
     1344          CALL abort_physic(modname,abort_message,1)
    13461345       ENDIF
    13471346       IF (nlev .NE. klev) THEN
    … …  
    13491348               klev
    13501349          abort_message='nlev et klev ne sont pas coherents'
    1351           call abort_physic(modname,abort_message,1)
     1350          CALL abort_physic(modname,abort_message,1)
    13521351       ENDIF
    13531352       !
    … …  
    13561355          WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
    13571356          abort_message='Nbre d appels au rayonnement insuffisant'
    1358           call abort_physic(modname,abort_message,1)
     1357          CALL abort_physic(modname,abort_message,1)
    13591358       ENDIF
    13601359       WRITE(lunout,*)"Clef pour la convection, iflag_con=", iflag_con
    … …  
    13871386          !CR:04.12.07: initialisations poches froides
    13881387          ! Controle de ALE et ALP pour la fermeture convective (jyg)
    1389           if (iflag_wake>=1) then
     1388          IF (iflag_wake>=1) THEN
    13901389             CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr &
    13911390                  ,alp_bl_prescr, ale_bl_prescr)
    … …  
    14071406             d_s_wk(:) = 0.
    14081407             d_dens_wk(:) = 0.
    1409           endif
     1408          ENDIF
    14101409
    14111410          !        do i = 1,klon
    … …  
    14191418          OPEN(98,file='npCFMIP_param.data',status='old', &
    14201419               form='formatted',iostat=iostat)
    1421           if (iostat == 0) then
     1420          IF (iostat == 0) THEN
    14221421             READ(98,*,end=998) nCFMIP
    14231422998          CONTINUE
    … …  
    14261425             IF(nCFMIP.GT.npCFMIP) THEN
    14271426                print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'
    1428                 call abort_physic("physiq", "", 1)
    1429              else
     1427                CALL abort_physic("physiq", "", 1)
     1428             ELSE
    14301429                print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP
    14311430             ENDIF
    … …  
    14541453                  tabijGCM, lonGCM, latGCM, iGCM, jGCM)
    14551454             !
    1456           else
     1455          ELSE
    14571456             ALLOCATE(tabijGCM(0))
    14581457             ALLOCATE(lonGCM(0), latGCM(0))
    14591458             ALLOCATE(iGCM(0), jGCM(0))
    1460           end if
    1461        else
     1459          ENDIF
     1460       ELSE
    14621461          ALLOCATE(tabijGCM(0))
    14631462          ALLOCATE(lonGCM(0), latGCM(0))
    … …  
    14901489             zuthe(i)=0.
    14911490             zvthe(i)=0.
    1492              if(zstd(i).gt.10.)then
     1491             IF (zstd(i).gt.10.) THEN
    14931492                zuthe(i)=(1.-zgam(i))*cos(zthe(i))
    14941493                zvthe(i)=(1.-zgam(i))*sin(zthe(i))
    1495              endif
     1494             ENDIF
    14961495          ENDDO
    14971496       ENDIF
    … …  
    15341533       ok_sync_omp=.false.
    15351534       CALL getin('ok_sync',ok_sync_omp)
    1536        call phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, &
     1535       CALL phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, &
    15371536            iGCM,jGCM,lonGCM,latGCM, &
    15381537            jjmp1,nlevSTD,clevSTD,rlevSTD, dtime,ok_veget, &
    … …  
    16081607          CALL VTb(VTphysiq)
    16091608#endif
    1610        END IF
     1609       ENDIF
    16111610       !
    16121611       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    16141613       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    16151614
    1616        call iniradia(klon,klev,paprs(1,1:klev+1))
     1615       CALL iniradia(klon,klev,paprs(1,1:klev+1))
    16171616
    16181617       !$omp single
    1619        if (read_climoz >= 1) then
    1620           call open_climoz(ncid_climoz, press_climoz)
    1621        END IF
     1618       IF (read_climoz >= 1) THEN
     1619          CALL open_climoz(ncid_climoz, press_climoz)
     1620       ENDIF
    16221621       !$omp end single
    16231622       !
    … …  
    17001699       CALL Rtime(debut)
    17011700#endif
    1702     END IF
     1701    ENDIF
    17031702
    17041703
    … …  
    17601759          ql_seri(i,k) = qx(i,k,iliq)
    17611760          !CR: ATTENTION, on rajoute la variable glace
    1762           if (nqo.eq.2) then
     1761          IF (nqo.eq.2) THEN
    17631762             qs_seri(i,k) = 0.
    1764           else if (nqo.eq.3) then
     1763          ELSE IF (nqo.eq.3) THEN
    17651764             qs_seri(i,k) = qx(i,k,isol)
    1766           endif
     1765          ENDIF
    17671766       ENDDO
    17681767    ENDDO
    … …  
    18081807    ENDDO
    18091808    ! Initialize variables used for diagnostic purpose
    1810     if (flag_inhib_tend .ne. 0) call init_cmp_seri
     1809    IF (flag_inhib_tend .ne. 0) CALL init_cmp_seri
    18111810    !IM
    18121811    IF (ip_ebil_phy.ge.1) THEN
    … …  
    18191818       !     est egale a la variation de la physique au pas de temps precedent.
    18201819       !     Donc la somme de ces 2 variations devrait etre nulle.
    1821        call diagphy(cell_area,ztit,ip_ebil_phy &
     1820       CALL diagphy(cell_area,ztit,ip_ebil_phy &
    18221821            , zero_v, zero_v, zero_v, zero_v, zero_v &
    18231822            , zero_v, zero_v, zero_v, ztsol &
    18241823            , d_h_vcol+d_h_vcol_phy, d_qt, 0. &
    18251824            , fs_bound, fq_bound )
    1826     END IF
     1825    ENDIF
    18271826
    18281827    ! Diagnostiquer la tendance dynamique
    … …  
    19351934      ELSE
    19361935        ro3i = int((days_elapsed + jh_cur - jh_1jan) / year_len * 360.) + 1   
    1937         if (ro3i == 361) ro3i = 360
    1938         if (read_climoz == 1) then
    1939            call regr_pr_av(ncid_climoz, (/"tro3"/), julien=ro3i, &
     1936        IF (ro3i == 361) ro3i = 360
     1937        IF (read_climoz == 1) THEN
     1938           CALL regr_pr_av(ncid_climoz, (/"tro3"/), julien=ro3i, &
    19401939                press_in_edg=press_climoz, paprs=paprs, v3=wo)
    1941         else
     1940        ELSE
    19421941           ! read_climoz == 2
    1943            call regr_pr_av(ncid_climoz, (/"tro3         ", &
     1942           CALL regr_pr_av(ncid_climoz, (/"tro3         ", &
    19441943                "tro3_daylight"/), julien=ro3i, press_in_edg=press_climoz, &
    19451944                paprs=paprs, v3=wo)
    1946         end if
     1945        ENDIF
    19471946        ! Convert from mole fraction of ozone to column density of ozone in a
    19481947        ! cell, in kDU:
    1949         forall (l = 1: read_climoz) wo(:, :, l) = wo(:, :, l) * rmo3 / rmd &
     1948        FORALL (l = 1: read_climoz) wo(:, :, l) = wo(:, :, l) * rmo3 / rmd &
    19501949             * zmasse / dobson_u / 1e3
    19511950        ! (By regridding ozone values for LMDZ only once every 360th of
    … …  
    19711970          !>jyg
    19721971
    1973           if (iflag_ice_thermo.eq.0) then   
     1972          IF (iflag_ice_thermo.eq.0) THEN   
    19741973             !pas necessaire a priori
    19751974
    … …  
    19841983             d_q_eva(i,k) = zb
    19851984
    1986           else
     1985          ELSE
    19871986
    19881987             !CR: on r\'e-\'evapore eau liquide et glace
    … …  
    20022001             d_t_eva(i,k) = za
    20032002             d_q_eva(i,k) = zb
    2004           endif
     2003          ENDIF
    20052004
    20062005       ENDDO
    … …  
    20122011            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    20132012            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2014        call diagphy(cell_area,ztit,ip_ebil_phy &
     2013       CALL diagphy(cell_area,ztit,ip_ebil_phy &
    20152014            , zero_v, zero_v, zero_v, zero_v, zero_v &
    20162015            , zero_v, zero_v, zero_v, ztsol &
    … …  
    20182017            , fs_bound, fq_bound )
    20192018       !
    2020     END IF
     2019    ENDIF
    20212020
    20222021    !
    … …  
    20272026
    20282027    ! !!   jyg 17 Sep 2010 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2029     call ymds2ju(year_cur, mth_eq, day_eq,0., jD_eq)
     2028    CALL ymds2ju(year_cur, mth_eq, day_eq,0., jD_eq)
    20302029    day_since_equinox = (jD_cur + jH_cur) - jD_eq
    20312030    !
    20322031    !   choix entre calcul de la longitude solaire vraie ou valeur fixee a
    20332032    !   solarlong0
    2034     if (solarlong0<-999.) then
    2035        if (new_orbit) then
     2033    IF (solarlong0<-999.) THEN
     2034       IF (new_orbit) THEN
    20362035          ! calcul selon la routine utilisee pour les planetes
    2037           call solarlong(day_since_equinox, zlongi, dist)
    2038        else
     2036          CALL solarlong(day_since_equinox, zlongi, dist)
     2037       ELSE
    20392038          ! calcul selon la routine utilisee pour l'AR4
    20402039          CALL orbite(REAL(days_elapsed+1),zlongi,dist)
    2041        endif
    2042     else
     2040       ENDIF
     2041    ELSE
    20432042       zlongi=solarlong0  ! longitude solaire vraie
    20442043       dist=1.            ! distance au soleil / moyenne
    2045     endif
    2046     if(prt_level.ge.1)                                                &
    2047         write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist
     2044    ENDIF
     2045
     2046    IF (prt_level.ge.1) write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist
    20482047
    20492048
    … …  
    20552054    ! Cet ensoleillement est sym\'etrique autour de l'\'equateur et
    20562055    ! non nul aux poles.
    2057     IF (abs(solarlong0-1000.)<1.e-4) then
    2058        call zenang_an(iflag_cycle_diurne.GE.1,jH_cur, &
     2056    IF (abs(solarlong0-1000.)<1.e-4) THEN
     2057       CALL zenang_an(iflag_cycle_diurne.GE.1,jH_cur, &
    20592058            latitude_deg,longitude_deg,rmu0,fract)
    20602059       JrNt = 1.0
    … …  
    21092108    ENDIF
    21102109
    2111     if (mydebug) then
    2112        call writefield_phy('u_seri',u_seri,nbp_lev)
    2113        call writefield_phy('v_seri',v_seri,nbp_lev)
    2114        call writefield_phy('t_seri',t_seri,nbp_lev)
    2115        call writefield_phy('q_seri',q_seri,nbp_lev)
    2116     endif
     2110    IF (mydebug) THEN
     2111       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     2112       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     2113       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     2114       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     2115    ENDIF
    21172116
    21182117    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    … …  
    21402139
    21412140
    2142     if (iflag_pbl/=0) then
     2141    IF (iflag_pbl/=0) THEN
    21432142
    21442143       !jyg+nrlmd<
    … …  
    22492248       !--------------------------------------------------------------------
    22502249
    2251        if (mydebug) then
    2252           call writefield_phy('u_seri',u_seri,nbp_lev)
    2253           call writefield_phy('v_seri',v_seri,nbp_lev)
    2254           call writefield_phy('t_seri',t_seri,nbp_lev)
    2255           call writefield_phy('q_seri',q_seri,nbp_lev)
    2256        endif
    2257 
     2250       IF (mydebug) THEN
     2251          CALL writefield_phy('u_seri',u_seri,nbp_lev)
     2252          CALL writefield_phy('v_seri',v_seri,nbp_lev)
     2253          CALL writefield_phy('t_seri',t_seri,nbp_lev)
     2254          CALL writefield_phy('q_seri',q_seri,nbp_lev)
     2255       ENDIF
    22582256
    22592257       !albedo SB >>>
    … …  
    22622260       falb1=0.
    22632261       falb2=0.
    2264        select case(nsw)
    2265        case(2)
     2262       SELECT CASE(nsw)
     2263       CASE(2)
    22662264          albsol1=albsol_dir(:,1)
    22672265          albsol2=albsol_dir(:,2)
    22682266          falb1=falb_dir(:,1,:)
    22692267          falb2=falb_dir(:,2,:)
    2270        case(4)
     2268       CASE(4)
    22712269          albsol1=albsol_dir(:,1)
    22722270          albsol2=albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3) &
    … …  
    22772275               +falb_dir(:,4,:)*SFRWL(4)
    22782276          falb2=falb2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
    2279        case(6)
     2277       CASE(6)
    22802278          albsol1=albsol_dir(:,1)*SFRWL(1)+albsol_dir(:,2)*SFRWL(2) &
    22812279               +albsol_dir(:,3)*SFRWL(3)
    … …  
    22902288               +falb_dir(:,6,:)*SFRWL(6)
    22912289          falb2=falb2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
    2292        end select
     2290       END SELECt
    22932291       !albedo SB <<<
    22942292
    … …  
    23032301               , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    23042302               , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2305           call diagphy(cell_area,ztit,ip_ebil_phy &
     2303          CALL diagphy(cell_area,ztit,ip_ebil_phy &
    23062304               , zero_v, zero_v, zero_v, zero_v, sens &
    23072305               , evap  , zero_v, zero_v, ztsol &
    23082306               , d_h_vcol, d_qt, d_ec &
    23092307               , fs_bound, fq_bound )
    2310        END IF
     2308       ENDIF
    23112309
    23122310    ENDIF
    … …  
    23352333    ENDDO
    23362334
    2337     if (prt_level.ge.1) then
     2335    IF (prt_level.ge.1) THEN
    23382336       write(lunout,*) 'L   qsat (g/kg) avant clouds_gno'
    23392337       write(lunout,'(i4,f15.4)') (k,1000.*zqsat(igout,k),k=1,klev)
    2340     endif
     2338    ENDIF
    23412339    !
    23422340    ! Appeler la convection (au choix)
    … …  
    23722370       DO i = 1, klon
    23732371          omega(i,k) = RG*flxmass_w(i,k) / cell_area(i)
    2374        END DO
    2375     END DO
    2376     if (prt_level.ge.1) write(lunout,*) 'omega(igout, :) = ', &
     2372       ENDDO
     2373    ENDDO
     2374
     2375    IF (prt_level.ge.1) write(lunout,*) 'omega(igout, :) = ', &
    23772376         omega(igout, :)
    23782377
    … …  
    24082407       !ajout pour la parametrisation des poches froides: calcul de
    24092408       !t_w et t_x: si pas de poches froides, t_w=t_x=t_seri
    2410        if (iflag_wake>=1) then
    2411          do k=1,klev
    2412             do i=1,klon
    2413                 t_w(i,k) = t_seri(i,k) &
    2414                      +(1-wake_s(i))*wake_deltat(i,k)
    2415                 q_w(i,k) = q_seri(i,k) &
    2416                      +(1-wake_s(i))*wake_deltaq(i,k)
    2417                 t_x(i,k) = t_seri(i,k) &
    2418                      -wake_s(i)*wake_deltat(i,k)
    2419                 q_x(i,k) = q_seri(i,k) &
    2420                      -wake_s(i)*wake_deltaq(i,k)
    2421             enddo
    2422          enddo
    2423        else
    2424                 t_w(:,:) = t_seri(:,:)
     2409       IF (iflag_wake>=1) THEN
     2410         DO k=1,klev
     2411            DO i=1,klon
     2412                t_w(i,k) = t_seri(i,k) + (1-wake_s(i))*wake_deltat(i,k)
     2413                q_w(i,k) = q_seri(i,k) + (1-wake_s(i))*wake_deltaq(i,k)
     2414                t_x(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
     2415                q_x(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
     2416            ENDDO
     2417         ENDDO
     2418       ELSE
     2419               t_w(:,:) = t_seri(:,:)
    24252420                q_w(:,:) = q_seri(:,:)
    24262421                t_x(:,:) = t_seri(:,:)
    24272422                q_x(:,:) = q_seri(:,:)
    2428        endif
     2423       ENDIF
    24292424       !
    24302425       !jyg<
    … …  
    24952490          ELSE
    24962491             nbtr_tmp=nbtr
    2497           END IF
     2492          ENDIF
    24982493          !jyg   iflag_con est dans clesphys
    24992494          !c          CALL concvl (iflag_con,iflag_clos,
    … …  
    25282523          pmfu(:,:)=upwd(:,:)+dnwd(:,:)
    25292524
    2530           do i = 1, klon
    2531              if (iflagctrl(i).le.1) itau_con(i)=itau_con(i)+1
    2532           enddo
     2525          DO i = 1, klon
     2526             IF (iflagctrl(i).le.1) itau_con(i)=itau_con(i)+1
     2527          ENDDO
    25332528          !
    25342529          !jyg<
    … …  
    25822577       clwcon0(:,:)=fact_cldcon*clwcon0(:,:)
    25832578       IF (iflag_cld_cv == 0) THEN
    2584           call clouds_gno &
     2579          CALL clouds_gno &
    25852580               (klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)
    25862581       ELSE
    2587           call clouds_bigauss &
     2582          CALL clouds_bigauss &
    25882583               (klon,klev,q_seri,zqsat,qtc_cv,sigt_cv,ptconv,ratqsc,rnebcon0)
    25892584       ENDIF
    … …  
    26052600          ema_pct(i)  = paprs(i,itop_con(i)+1)
    26062601
    2607           if (itop_con(i).gt.klev-3) then
    2608              if(prt_level >= 9) then
     2602          IF (itop_con(i).gt.klev-3) THEN
     2603             IF (prt_level >= 9) THEN
    26092604                write(lunout,*)'La convection monte trop haut '
    26102605                write(lunout,*)'itop_con(,',i,',)=',itop_con(i)
    2611              endif
    2612           endif
     2606             ENDIF
     2607          ENDIF
    26132608       ENDDO
    26142609    ELSE IF (iflag_con.eq.0) THEN
    … …  
    26262621    ELSE
    26272622       WRITE(lunout,*) "iflag_con non-prevu", iflag_con
    2628        call abort_physic("physiq", "", 1)
     2623       CALL abort_physic("physiq", "", 1)
    26292624    ENDIF
    26302625
    … …  
    26372632    !-------------------------------------------------------------------------
    26382633
    2639     if (mydebug) then
    2640        call writefield_phy('u_seri',u_seri,nbp_lev)
    2641        call writefield_phy('v_seri',v_seri,nbp_lev)
    2642        call writefield_phy('t_seri',t_seri,nbp_lev)
    2643        call writefield_phy('q_seri',q_seri,nbp_lev)
    2644     endif
     2634    IF (mydebug) THEN
     2635       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     2636       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     2637       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     2638       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     2639    ENDIF
    26452640
    26462641    !IM
    … …  
    26502645            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    26512646            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2652        call diagphy(cell_area,ztit,ip_ebil_phy &
     2647       CALL diagphy(cell_area,ztit,ip_ebil_phy &
    26532648            , zero_v, zero_v, zero_v, zero_v, zero_v &
    26542649            , zero_v, rain_con, snow_con, ztsol &
    26552650            , d_h_vcol, d_qt, d_ec &
    26562651            , fs_bound, fq_bound )
    2657     END IF
     2652    ENDIF
    26582653    !
    26592654    IF (check) THEN
    … …  
    27052700    ! froides
    27062701    !
    2707     if (iflag_wake>=1) then
     2702    IF (iflag_wake>=1) THEN
    27082703       DO k=1,klev
    27092704          DO i=1,klon
    … …  
    27442739       !
    27452740       !calcul caracteristiques de la poche froide
    2746        call calWAKE (iflag_wake_tend, paprs, pplay, dtime, &
     2741       CALL calWAKE (iflag_wake_tend, paprs, pplay, dtime, &
    27472742            t_seri, q_seri, omega,  &
    27482743            dt_dwn, dq_dwn, M_dwn, M_up,  &
    … …  
    27752770       ENDIF   ! (iflag_wake_tend .GT. 0.)
    27762771
    2777     endif  ! (iflag_wake>=1)
     2772    ENDIF  ! (iflag_wake>=1)
    27782773    !
    27792774    !===================================================================
    … …  
    27842779            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    27852780            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2786        call diagphy(cell_area,ztit,ip_ebil_phy &
     2781       CALL diagphy(cell_area,ztit,ip_ebil_phy &
    27872782            , zero_v, zero_v, zero_v, zero_v, zero_v &
    27882783            , zero_v, zero_v, zero_v, ztsol &
    27892784            , d_h_vcol, d_qt, d_ec &
    27902785            , fs_bound, fq_bound )
    2791     END IF
     2786    ENDIF
    27922787
    27932788    !      print*,'apres callwake iflag_cld_th=', iflag_cld_th
    … …  
    27972792    !===================================================================
    27982793    !
    2799     call stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri &
     2794    CALL stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri &
    28002795         ,seuil_inversion,weak_inversion,dthmin)
    28012796
    … …  
    28142809    !      detr_therm(:,:)=0.
    28152810    !
    2816     IF(prt_level>9)WRITE(lunout,*) &
     2811    IF (prt_level>9) WRITE(lunout,*) &
    28172812         'AVANT LA CONVECTION SECHE , iflag_thermals=' &
    28182813         ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
    2819     if(iflag_thermals<0) then
     2814    IF (iflag_thermals<0) THEN
    28202815       !  Rien
    28212816       !  ====
    2822        IF(prt_level>9)WRITE(lunout,*)'pas de convection seche'
    2823 
    2824 
    2825     else
     2817       IF (prt_level>9) WRITE(lunout,*)'pas de convection seche'
     2818
     2819
     2820    ELSE
    28262821
    28272822       !  Thermiques
    28282823       !  ==========
    2829        IF(prt_level>9)WRITE(lunout,*)'JUSTE AVANT , iflag_thermals=' &
     2824       IF (prt_level>9) WRITE(lunout,*)'JUSTE AVANT , iflag_thermals=' &
    28302825            ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
    28312826
    … …  
    28422837       !cc fin nrlmd le 10/04/2012
    28432838
    2844        if (iflag_thermals>=1) then
     2839       IF (iflag_thermals>=1) THEN
    28452840          !jyg<
    28462841          IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
    … …  
    28662861          ENDIF
    28672862          !>jyg
    2868           call calltherm(pdtphys &
     2863          CALL calltherm(pdtphys &
    28692864               ,pplay,paprs,pphi,weak_inversion &
    28702865                        ! ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & !jyg
    … …  
    29322927          ! -------------------------------------------------------------------
    29332928
    2934           do i=1,klon
     2929          DO i=1,klon
    29352930             !           zmax_th(i)=pphi(i,lmax_th(i))/rg
    29362931             !CR:04/05/12:correction calcul zmax
    29372932             zmax_th(i)=zmax0(i)
    2938           enddo
    2939 
    2940        endif
    2941 
     2933          ENDDO
     2934
     2935       ENDIF
    29422936
    29432937       !  Ajustement sec
    … …  
    29482942       ! Dans le cas contraire, on demarre au niveau 1.
    29492943
    2950        if (iflag_thermals>=13.or.iflag_thermals<=0) then
    2951 
    2952           if(iflag_thermals.eq.0) then
    2953              IF(prt_level>9)WRITE(lunout,*)'ajsec'
     2944       IF (iflag_thermals>=13.or.iflag_thermals<=0) THEN
     2945
     2946          IF (iflag_thermals.eq.0) THEN
     2947             IF (prt_level>9) WRITE(lunout,*)'ajsec'
    29542948             limbas(:)=1
    2955           else
     2949          ELSE
    29562950             limbas(:)=lmax_th(:)
    2957           endif
     2951          ENDIF
    29582952
    29592953          ! Attention : le call ajsec_convV2 n'est maintenu que momentanneement
    … …  
    29632957          ! non nulles numeriquement pour des mailles non concernees.
    29642958
    2965           if (iflag_thermals==0) then
     2959          IF (iflag_thermals==0) THEN
    29662960             ! Calling adjustment alone (but not the thermal plume model)
    29672961             CALL ajsec_convV2(paprs, pplay, t_seri,q_seri &
    29682962                  , d_t_ajsb, d_q_ajsb)
    2969           else if (iflag_thermals>0) then
     2963          ELSE IF (iflag_thermals>0) THEN
    29702964             ! Calling adjustment above the top of thermal plumes
    29712965             CALL ajsec(paprs, pplay, t_seri,q_seri,limbas &
    29722966                  , d_t_ajsb, d_q_ajsb)
    2973           endif
     2967          ENDIF
    29742968
    29752969          !--------------------------------------------------------------------
    … …  
    29822976          !---------------------------------------------------------------------
    29832977
    2984        endif
    2985 
    2986     endif
     2978       ENDIF
     2979
     2980    ENDIF
    29872981    !
    29882982    !===================================================================
    … …  
    29932987            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    29942988            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2995        call diagphy(cell_area,ztit,ip_ebil_phy &
     2989       CALL diagphy(cell_area,ztit,ip_ebil_phy &
    29962990            , zero_v, zero_v, zero_v, zero_v, zero_v &
    29972991            , zero_v, zero_v, zero_v, ztsol &
    29982992            , d_h_vcol, d_qt, d_ec &
    29992993            , fs_bound, fq_bound )
    3000     END IF
     2994    ENDIF
    30012995
    30022996
    … …  
    30833077            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    30843078            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    3085        call diagphy(cell_area,ztit,ip_ebil_phy &
     3079       CALL diagphy(cell_area,ztit,ip_ebil_phy &
    30863080            , zero_v, zero_v, zero_v, zero_v, zero_v &
    30873081            , zero_v, rain_lsc, snow_lsc, ztsol &
    30883082            , d_h_vcol, d_qt, d_ec &
    30893083            , fs_bound, fq_bound )
    3090     END IF
    3091 
    3092     if (mydebug) then
    3093        call writefield_phy('u_seri',u_seri,nbp_lev)
    3094        call writefield_phy('v_seri',v_seri,nbp_lev)
    3095        call writefield_phy('t_seri',t_seri,nbp_lev)
    3096        call writefield_phy('q_seri',q_seri,nbp_lev)
    3097     endif
     3084    ENDIF
     3085
     3086    IF (mydebug) THEN
     3087       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     3088       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     3089       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     3090       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     3091    ENDIF
    30983092
    30993093    !
    … …  
    31103104       !     print*,'avant calcul de la pseudo precip '
    31113105       !     print*,'iflag_cld_th',iflag_cld_th
    3112        if (iflag_cld_th.eq.-1) then
     3106       IF (iflag_cld_th.eq.-1) THEN
    31133107          rain_tiedtke=rain_con
    3114        else
     3108       ELSE
    31153109          !       print*,'calcul de la pseudo precip '
    31163110          rain_tiedtke=0.
    31173111          !         print*,'calcul de la pseudo precip 0'
    3118           do k=1,klev
    3119              do i=1,klon
    3120                 if (d_q_con(i,k).lt.0.) then
     3112          DO k=1,klev
     3113             DO i=1,klon
     3114                IF (d_q_con(i,k).lt.0.) THEN
    31213115                   rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys &
    31223116                        *(paprs(i,k)-paprs(i,k+1))/rg
    3123                 endif
    3124              enddo
    3125           enddo
    3126        endif
     3117                ENDIF
     3118             ENDDO
     3119          ENDDO
     3120       ENDIF
    31273121       !
    31283122       !     call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')
    … …  
    31483142       !  facttemps
    31493143       facteur = pdtphys *facttemps
    3150        do k=1,klev
    3151           do i=1,klon
     3144       DO k=1,klev
     3145          DO i=1,klon
    31523146             rnebcon(i,k)=rnebcon(i,k)*facteur
    3153              if (rnebcon0(i,k)*clwcon0(i,k).gt.rnebcon(i,k)*clwcon(i,k)) &
    3154                   then
     3147             IF (rnebcon0(i,k)*clwcon0(i,k).GT.rnebcon(i,k)*clwcon(i,k)) THEN
    31553148                rnebcon(i,k)=rnebcon0(i,k)
    31563149                clwcon(i,k)=clwcon0(i,k)
    3157              endif
    3158           enddo
    3159        enddo
     3150             ENDIF
     3151          ENDDO
     3152       ENDDO
    31603153
    31613154       !   On prend la somme des fractions nuageuses et des contenus en eau
    31623155
    3163        if (iflag_cld_th>=5) then
    3164 
    3165           do k=1,klev
     3156       IF (iflag_cld_th>=5) THEN
     3157
     3158          DO k=1,klev
    31663159             ptconvth(:,k)=fm_therm(:,k+1)>0.
    3167           enddo
    3168 
    3169           if (iflag_coupl==4) then
     3160          ENDDO
     3161
     3162          IF (iflag_coupl==4) THEN
    31703163
    31713164             ! Dans le cas iflag_coupl==4, on prend la somme des convertures
    31723165             ! convectives et lsc dans la partie des thermiques
    31733166             ! Le controle par iflag_coupl est peut etre provisoire.
    3174              do k=1,klev
    3175                 do i=1,klon
    3176                    if (ptconv(i,k).and.ptconvth(i,k)) then
     3167             DO k=1,klev
     3168                DO i=1,klon
     3169                   IF (ptconv(i,k).AND.ptconvth(i,k)) THEN
    31773170                      cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
    31783171                      cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
    3179                    else if (ptconv(i,k)) then
     3172                   ELSE IF (ptconv(i,k)) THEN
    31803173                      cldfra(i,k)=rnebcon(i,k)
    31813174                      cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
    3182                    endif
    3183                 enddo
    3184              enddo
    3185 
    3186           else if (iflag_coupl==5) then
    3187              do k=1,klev
    3188                 do i=1,klon
     3175                   ENDIF
     3176                ENDDO
     3177             ENDDO
     3178
     3179          ELSE IF (iflag_coupl==5) THEN
     3180             DO k=1,klev
     3181                DO i=1,klon
    31893182                   cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
    31903183                   cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
    3191                 enddo
    3192              enddo
    3193 
    3194           else
     3184                ENDDO
     3185             ENDDO
     3186
     3187          ELSE
    31953188
    31963189             ! Si on est sur un point touche par la convection
    … …  
    32023195             ! definition des points sur lesquels ls thermiques sont actifs
    32033196
    3204              do k=1,klev
    3205                 do i=1,klon
    3206                    if (ptconv(i,k).and. .not. ptconvth(i,k)) then
     3197             DO k=1,klev
     3198                DO i=1,klon
     3199                   IF (ptconv(i,k).AND. .NOT.ptconvth(i,k)) THEN
    32073200                      cldfra(i,k)=rnebcon(i,k)
    32083201                      cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
    3209                    endif
    3210                 enddo
    3211              enddo
    3212 
    3213           endif
    3214 
    3215        else
     3202                   ENDIF
     3203                ENDDO
     3204             ENDDO
     3205
     3206          ENDIF
     3207
     3208       ELSE
    32163209
    32173210          ! Ancienne version
    32183211          cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
    32193212          cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)
    3220        endif
     3213       ENDIF
    32213214
    32223215    ENDIF
    … …  
    32563249            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    32573250            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    3258        call diagphy(cell_area,ztit,ip_ebil_phy &
     3251       CALL diagphy(cell_area,ztit,ip_ebil_phy &
    32593252            , zero_v, zero_v, zero_v, zero_v, zero_v &
    32603253            , zero_v, zero_v, zero_v, ztsol &
    32613254            , d_h_vcol, d_qt, d_ec &
    32623255            , fs_bound, fq_bound )
    3263     END IF
     3256    ENDIF
    32643257    !
    32653258    ! Calculer l'humidite relative pour diagnostique
    … …  
    33193312       calday = REAL(days_elapsed + 1) + jH_cur
    33203313
    3321        call chemtime(itap+itau_phy-1, date0, dtime, itap)
     3314       CALL chemtime(itap+itau_phy-1, date0, dtime, itap)
    33223315       IF (config_inca == 'aero' .OR. config_inca == 'aeNP') THEN
    33233316          CALL AEROSOL_METEO_CALC( &
    … …  
    33253318               prfl,psfl,pctsrf,cell_area, &
    33263319               latitude_deg,longitude_deg,u10m,v10m)
    3327        END IF
     3320       ENDIF
    33283321
    33293322       zxsnow_dummy(:) = 0.0
    … …  
    33683361       CALL VTb(VTphysiq)
    33693362#endif
    3370     END IF !type_trac = inca
     3363    ENDIF !type_trac = inca
    33713364
    33723365
    … …  
    33933386             IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
    33943387                abort_message='config_inca=aero et rrtm=1 impossible'
    3395                 call abort_physic(modname,abort_message,1)
     3388                CALL abort_physic(modname,abort_message,1)
    33963389             ELSE
    33973390                !
    … …  
    34283421                   abort_message='Only NSW=2 or 6 are possible with ' &
    34293422                        // 'aerosols and iflag_rrtm=1'
    3430                    call abort_physic(modname,abort_message,1)
     3423                   CALL abort_physic(modname,abort_message,1)
    34313424                ENDIF
    34323425
    … …  
    34383431                abort_message='You should compile with -rrtm if running ' &
    34393432                     // 'with iflag_rrtm=1'
    3440                 call abort_physic(modname,abort_message,1)
     3433                CALL abort_physic(modname,abort_message,1)
    34413434#endif
    34423435                !
    … …  
    34973490#ifdef CPP_RRTM
    34983491#ifdef CPP_StratAer
     3492       !--compute stratospheric mask
     3493       CALL stratosphere_mask(t_seri, pplay, latitude_deg)
    34993494       !--interactive strat aerosols
    35003495       CALL calcaerosolstrato_rrtm(pplay,t_seri,paprs,debut)
    … …  
    35103505          mass_solu_aero(:,:)    = ccm(:,:,1)
    35113506          mass_solu_aero_pi(:,:) = ccm(:,:,2)
    3512        END IF
     3507       ENDIF
    35133508
    35143509       IF (ok_newmicro) then
    … …  
    36193614       ENDIF
    36203615
    3621        if (mydebug) then
    3622           call writefield_phy('u_seri',u_seri,nbp_lev)
    3623           call writefield_phy('v_seri',v_seri,nbp_lev)
    3624           call writefield_phy('t_seri',t_seri,nbp_lev)
    3625           call writefield_phy('q_seri',q_seri,nbp_lev)
    3626        endif
     3616       IF (mydebug) THEN
     3617          CALL writefield_phy('u_seri',u_seri,nbp_lev)
     3618          CALL writefield_phy('v_seri',v_seri,nbp_lev)
     3619          CALL writefield_phy('t_seri',t_seri,nbp_lev)
     3620          CALL writefield_phy('q_seri',q_seri,nbp_lev)
     3621       ENDIF
    36273622
    36283623       !
    … …  
    36323627       IF (iflag_radia .ge. 2) THEN
    36333628          zsav_tsol (:) = zxtsol(:)
    3634           call perturb_radlwsw(zxtsol,iflag_radia)
     3629          CALL perturb_radlwsw(zxtsol,iflag_radia)
    36353630       ENDIF
    36363631
    … …  
    37213716          !IM Par defaut on a les taux perturbes egaux aux taux actuels
    37223717          !
    3723           if (ok_4xCO2atm) then
    3724              if (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. &
    3725                   RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR. &
    3726                   RCFC12_per.NE.RCFC12_act) THEN
     3718          IF (ok_4xCO2atm) THEN
     3719             IF (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR.    &
     3720                 RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR. &
     3721                 RCFC12_per.NE.RCFC12_act) THEN
    37273722                !
    37283723                RCO2 = RCO2_per
    … …  
    37923787          PRINT *,'>>>>           heat et cool mis a zero '
    37933788          PRINT *,'--------------------------------------------------'
    3794        END IF
     3789       ENDIF
    37953790       heat=0.
    37963791       cool=0.
    … …  
    38043799       lwdn=0.
    38053800       lwdn0=0.
    3806     END IF
     3801    ENDIF
    38073802
    38083803    !
    … …  
    38133808    radsol=solsw*swradcorr+sollw
    38143809
    3815     if (ok_4xCO2atm) then
     3810    IF (ok_4xCO2atm) THEN
    38163811       radsolp=solswp*swradcorr+sollwp
    3817     endif
     3812    ENDIF
    38183813
    38193814    !
    … …  
    38333828
    38343829    !
    3835     if (mydebug) then
    3836        call writefield_phy('u_seri',u_seri,nbp_lev)
    3837        call writefield_phy('v_seri',v_seri,nbp_lev)
    3838        call writefield_phy('t_seri',t_seri,nbp_lev)
    3839        call writefield_phy('q_seri',q_seri,nbp_lev)
    3840     endif
     3830    IF (mydebug) THEN
     3831       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     3832       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     3833       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     3834       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     3835    ENDIF
    38413836
    38423837    !IM
    … …  
    38463841            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    38473842            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    3848        call diagphy(cell_area,ztit,ip_ebil_phy &
     3843       CALL diagphy(cell_area,ztit,ip_ebil_phy &
    38493844            , topsw, toplw, solsw, sollw, zero_v &
    38503845            , zero_v, zero_v, zero_v, ztsol &
    38513846            , d_h_vcol, d_qt, d_ec &
    38523847            , fs_bound, fq_bound )
    3853     END IF
     3848    ENDIF
    38543849    !
    38553850    !
    … …  
    39193914    ENDIF ! fin de test sur ok_orodr
    39203915    !
    3921     if (mydebug) then
    3922        call writefield_phy('u_seri',u_seri,nbp_lev)
    3923        call writefield_phy('v_seri',v_seri,nbp_lev)
    3924        call writefield_phy('t_seri',t_seri,nbp_lev)
    3925        call writefield_phy('q_seri',q_seri,nbp_lev)
    3926     endif
     3916    IF (mydebug) THEN
     3917       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     3918       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     3919       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     3920       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     3921    ENDIF
    39273922
    39283923    IF (ok_orolf) THEN
    … …  
    40033998    ENDIF
    40043999
    4005     if (ok_gwd_rando) then
    4006        call FLOTT_GWD_rando(DTIME, pplay, t_seri, u_seri, v_seri, &
     4000    IF (ok_gwd_rando) THEN
     4001       CALL FLOTT_GWD_rando(DTIME, pplay, t_seri, u_seri, v_seri, &
    40074002            rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, &
    40084003            du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress)
    … …  
    40174012               * (paprs(:, k)-paprs(:, k+1))/rg
    40184013       ENDDO
    4019     end if
     4014    ENDIF
    40204015
    40214016    ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
    40224017
    4023     if (mydebug) then
    4024        call writefield_phy('u_seri',u_seri,nbp_lev)
    4025        call writefield_phy('v_seri',v_seri,nbp_lev)
    4026        call writefield_phy('t_seri',t_seri,nbp_lev)
    4027        call writefield_phy('q_seri',q_seri,nbp_lev)
    4028     endif
     4018    IF (mydebug) THEN
     4019       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     4020       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     4021       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     4022       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     4023    ENDIF
    40294024
    40304025    DO i = 1, klon
    … …  
    40594054            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    40604055            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    4061        call diagphy(cell_area,ztit,ip_ebil_phy &
     4056       CALL diagphy(cell_area,ztit,ip_ebil_phy &
    40624057            , zero_v, zero_v, zero_v, zero_v, zero_v &
    40634058            , zero_v, zero_v, zero_v, ztsol &
    40644059            , d_h_vcol, d_qt, d_ec &
    40654060            , fs_bound, fq_bound )
    4066     END IF
     4061    ENDIF
    40674062
    40684063    !DC Calcul de la tendance due au methane
    … …  
    40724067       CALL add_phys_tend(du0, dv0, dt0, d_q_ch4*dtime, dql0, dqi0, paprs, &
    40734068            'q_ch4', abortphy,flag_inhib_tend)
    4074     END IF
     4069    ENDIF
    40754070    !
    40764071    !
    … …  
    40914086          !       print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=',
    40924087          !     s        ref_liq,ref_ice
    4093           call phys_cosp(itap,dtime,freq_cosp, &
     4088          CALL phys_cosp(itap,dtime,freq_cosp, &
    40944089               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
    40954090               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, &
    … …  
    41214116
    41224117  IF (itap.eq.1.or.MOD(itap,NINT(freq_airs/dtime)).EQ.0) THEN
    4123   write(*,*) 'je vais appeler simu_airs, ok_airs, freq_airs=', &
    4124      & ok_airs, freq_airs
    4125   call simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,&
    4126      & map_prop_hc,map_prop_hist,&
    4127      & map_emis_hc,map_iwp_hc,map_deltaz_hc,map_pcld_hc,map_tcld_hc,&
    4128      & map_emis_Cb,map_pcld_Cb,map_tcld_Cb,&
    4129      & map_emis_ThCi,map_pcld_ThCi,map_tcld_ThCi,&
    4130      & map_emis_Anv,map_pcld_Anv,map_tcld_Anv,&
    4131      & map_emis_hist,map_iwp_hist,map_deltaz_hist,map_rad_hist,&
    4132      & map_ntot,map_hc,map_hist,&
    4133      & map_Cb,map_ThCi,map_Anv,&
    4134      & alt_tropo )
     4118     write(*,*) 'je vais appeler simu_airs, ok_airs, freq_airs=', ok_airs, freq_airs
     4119     CALL simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,&
     4120        & map_prop_hc,map_prop_hist,&
     4121        & map_emis_hc,map_iwp_hc,map_deltaz_hc,map_pcld_hc,map_tcld_hc,&
     4122        & map_emis_Cb,map_pcld_Cb,map_tcld_Cb,&
     4123        & map_emis_ThCi,map_pcld_ThCi,map_tcld_ThCi,&
     4124        & map_emis_Anv,map_pcld_Anv,map_tcld_Anv,&
     4125        & map_emis_hist,map_iwp_hist,map_deltaz_hist,map_rad_hist,&
     4126        & map_ntot,map_hc,map_hist,&
     4127        & map_Cb,map_ThCi,map_Anv,&
     4128        & alt_tropo )
    41354129  ENDIF
    41364130
    … …  
    41514145    ELSE
    41524146       sh_in(:,:) = qx(:,:,ivap)
    4153     END IF
     4147    ENDIF
    41544148
    41554149#ifdef CPP_Dust
    … …  
    41714165#else
    41724166
    4173     call phytrac ( &
     4167    CALL phytrac ( &
    41744168         itap,     days_elapsed+1,    jH_cur,   debut, &
    41754169         lafin,    dtime,     u, v,     t, &
    … …  
    42014195       IF (prt_level.ge.9) &
    42024196            print*,'Attention on met a 0 les thermiques pour phystoke'
    4203        call phystokenc ( &
     4197       CALL phystokenc ( &
    42044198            nlon,klev,pdtphys,longitude_deg,latitude_deg, &
    42054199            t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
    … …  
    42554249       !     Donc la somme de ces 2 variations devrait etre nulle.
    42564250
    4257        call diagphy(cell_area,ztit,ip_ebil_phy &
     4251       CALL diagphy(cell_area,ztit,ip_ebil_phy &
    42584252            , topsw, toplw, solsw, sollw, sens &
    42594253            , evap, rain_fall, snow_fall, ztsol &
    … …  
    42634257       d_h_vcol_phy=d_h_vcol
    42644258       !
    4265     END IF
     4259    ENDIF
    42664260    !
    42674261    !=======================================================================
    … …  
    43264320       CALL VTb(VTphysiq)
    43274321#endif
    4328     END IF
     4322    ENDIF
    43294323
    43304324
    … …  
    43364330    ENDIF
    43374331    !
    4338     if (mydebug) then
    4339        call writefield_phy('u_seri',u_seri,nbp_lev)
    4340        call writefield_phy('v_seri',v_seri,nbp_lev)
    4341        call writefield_phy('t_seri',t_seri,nbp_lev)
    4342        call writefield_phy('q_seri',q_seri,nbp_lev)
    4343     endif
     4332    IF (mydebug) THEN
     4333       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     4334       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     4335       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     4336       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     4337    ENDIF
    43444338
    43454339    DO k = 1, klev
    … …  
    43514345          d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
    43524346          !CR: on ajoute le contenu en glace
    4353           if (nqo.eq.3) then
     4347          IF (nqo.eq.3) THEN
    43544348             d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / dtime
    4355           endif
     4349          ENDIF
    43564350       ENDDO
    43574351    ENDDO
    … …  
    44204414    !==========================================================================
    44214415
    4422     if (prt_level.ge.1) then
     4416    IF (prt_level.ge.1) THEN
    44234417       write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
    44244418       write(lunout,*) &
    … …  
    44294423            pctsrf(igout,is_sic)
    44304424       write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
    4431        do k=1,klev
     4425       DO k=1,klev
    44324426          write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
    44334427               d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
    44344428               d_t_eva(igout,k)
    4435        enddo
     4429       ENDDO
    44364430       write(lunout,*) 'cool,heat'
    4437        do k=1,klev
     4431       DO k=1,klev
    44384432          write(lunout,*) cool(igout,k),heat(igout,k)
    4439        enddo
     4433       ENDDO
    44404434
    44414435       !jyg<     (En attendant de statuer sur le sort de d_t_oli)
    … …  
    44464440       !jyg!     enddo
    44474441       write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
    4448        do k=1,klev
     4442       DO k=1,klev
    44494443          write(lunout,*) d_t_vdf(igout,k), &
    44504444               d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
    4451        enddo
     4445       ENDDO
    44524446       !>jyg
    44534447
    44544448       write(lunout,*) 'd_ps ',d_ps(igout)
    44554449       write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
    4456        do k=1,klev
     4450       DO k=1,klev
    44574451          write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
    44584452               d_qx(igout,k,1),d_qx(igout,k,2)
    4459        enddo
    4460     endif
    4461 
    4462     !==========================================================================
     4453       ENDDO
     4454    ENDIF
    44634455
    44644456    !============================================================
    … …  
    45014493    !=============================================================
    45024494
    4503     if (iflag_thermals>=1) then
     4495    IF (iflag_thermals>=1) THEN
    45044496       d_t_lscth=0.
    45054497       d_t_lscst=0.
    45064498       d_q_lscth=0.
    45074499       d_q_lscst=0.
    4508        do k=1,klev
    4509           do i=1,klon
    4510              if (ptconvth(i,k)) then
     4500       DO k=1,klev
     4501          DO i=1,klon
     4502             IF (ptconvth(i,k)) THEN
    45114503                d_t_lscth(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
    45124504                d_q_lscth(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
    4513              else
     4505             ELSE
    45144506                d_t_lscst(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
    45154507                d_q_lscst(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
    4516              endif
    4517           enddo
    4518        enddo
    4519 
    4520        do i=1,klon
     4508             ENDIF
     4509          ENDDO
     4510       ENDDO
     4511
     4512       DO i=1,klon
    45214513          plul_st(i)=prfl(i,lmax_th(i)+1)+psfl(i,lmax_th(i)+1)
    45224514          plul_th(i)=prfl(i,1)+psfl(i,1)
    4523        enddo
    4524     endif
    4525 
     4515       ENDDO
     4516    ENDIF
    45264517
    45274518    !On effectue les sorties:
    … …  
    45434534#endif
    45444535
    4545 
    45464536#ifndef CPP_XIOS
    45474537    CALL write_paramLMDZ_phy(itap,nid_ctesGCM,ok_sync)
    … …  
    45754565       !         close(97)
    45764566       !$OMP MASTER
    4577        if (read_climoz >= 1) then
    4578           if (is_mpi_root) then
    4579              call nf95_close(ncid_climoz)
    4580           end if
    4581           deallocate(press_climoz) ! pointer
    4582        end if
     4567       IF (read_climoz >= 1) THEN
     4568          IF (is_mpi_root) THEN
     4569             CALL nf95_close(ncid_climoz)
     4570          ENDIF
     4571          DEALLOCATE(press_climoz) ! pointer
     4572       ENDIF
    45834573       !$OMP END MASTER
    45844574    ENDIF
Note: See TracChangeset for help on using the changeset viewer.