Ignore:
Timestamp:
Jul 19, 2024, 7:54:50 PM (4 months ago)
Author:
abarral
Message:

convert labeled do (f77) to do .. end do

Location:
LMDZ6/branches/Amaury_dev/libf/phylmd/cosp
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/icarus.F

    r5082 r5086  
    364364      enddo
    365365
    366       do 12 ilev=1,nlev
     366      do ilev=1,nlev
    367367        do j=1,npoints
    368368         if (pfull(j,ilev) < 40000. .and.
    … …  
    375375           end if
    376376        enddo
    377 12    continue
    378 
    379       do 13 ilev=1,nlev
     377      END DO
     378
     379      do ilev=1,nlev
    380380        do j=1,npoints
    381381           if (at(j,ilev) > atmax(j) .and.
    382382     &              ilev  >= itrop(j)) atmax(j)=at(j,ilev)
    383383        enddo
    384 13    continue
     384      END DO
    385385
    386386      end if
    … …  
    391391              meantb(j) = 0.
    392392              meantbclr(j) = 0.
    393           end do
     393          END DO
    394394      else
    395395          do j=1,npoints
    396396              meantb(j) = output_missing_value
    397397              meantbclr(j) = output_missing_value
    398           end do
     398          END DO
    399399      end if
    400400     
    … …  
    466466 
    467467      !initialize tau and albedocld to zero
    468       do 15 ibox=1,ncol
     468      do ibox=1,ncol
    469469        do j=1,npoints
    470470            tau(j,ibox)=0.
    … …  
    474474          box_cloudy(j,ibox)=.false.
    475475        enddo
    476 15    continue
     476      END DO
    477477
    478478      !compute total cloud optical depth for each column     
    … …  
    541541        if (ncolprint /= 0)
    542542     &         write(6,*)  'ilev   pw (kg/m2)   tauwv(j)      dem_wv'
    543         do 125 ilev=1,nlev
     543        do ilev=1,nlev
    544544          do j=1,npoints
    545545               !press and dpress are dyne/cm2 = Pascals *10
    … …  
    568568               enddo
    569569             endif
    570 125     continue
     570      END DO
    571571
    572572        !initialize variables
    … …  
    740740            bb(j)=1/( exp(1307.27/skt(j)) - 1. )
    741741            !bb(j)=5.67e-8*skt(j)**4
    742           end do
     742          END DO
    743743
    744744        do ibox=1,ncol
    … …  
    751751     &         * trans_layers_above(j,ibox)
    752752           
    753           end do
    754         end do
     753          END DO
     754        END DO
    755755
    756756        !calculate mean infrared brightness temperature
    … …  
    758758          do j=1,npoints
    759759            meantb(j) = meantb(j)+1307.27/(log(1.+(1./fluxtop(j,ibox))))
    760           end do
    761         end do
     760          END DO
     761        END DO
    762762          do j=1, npoints
    763763            meantb(j) = meantb(j) / real(ncol)
    764           end do       
     764          END DO
    765765
    766766        if (ncolprint/=0) then
    … …  
    784784          write (6,'(8f7.2)') (meantb(j),ibox=1,ncolprint)
    785785     
    786           end do
     786          END DO
    787787      endif
    788788   
    … …  
    925925
    926926      !compute cloud top pressure
    927       do 30 ibox=1,ncol
     927      do ibox=1,ncol
    928928        !segregate according to optical thickness
    929929        if (top_height == 1 .or. top_height == 3) then
    … …  
    933933            nmatch(j)=0
    934934          enddo
    935           do 29 k1=1,nlev-1
     935          do k1=1,nlev-1
    936936            if (top_height_direction == 2) then
    937937              ilev = nlev - k1
    … …  
    951951             end if                         
    952952            enddo
    953 29        continue
     953      END DO
    954954
    955955          do j=1,npoints
    … …  
    992992              levmatch(j,ibox)=ilev
    993993              end if
    994             end do
    995           end do
     994            END DO
     995          END DO
    996996        end if                           
    997997         
    … …  
    10031003        enddo
    10041004
    1005 30    continue
     1005      END DO
    10061006             
    10071007!
    … …  
    10321032
    10331033      !reset frequencies
    1034       do 38 ilev=1,7
     1034      do ilev=1,7
    10351035      do 38 ilev2=1,7
    10361036        do j=1,npoints !
    … …  
    10421042        enddo
    1043104338    continue
     1044      END DO
    10441045
    10451046      !reset variables need for averaging cloud properties
    … …  
    10601061      boxarea = 1./real(ncol)
    10611062     
    1062       do 39 ibox=1,ncol
     1063      do ibox=1,ncol
    10631064        do j=1,npoints
    10641065
    … …  
    11661167                       
    11671168        enddo ! j
    1168 39    continue
     1169      END DO
    11691170     
    11701171      !compute mean cloud properties
    … …  
    12271228     &           (cchar_realtops(acc(ilev,ibox)+1),ilev=1,nlev)
    12281229     &           ,(cchar(acc(ilev,ibox)+1),ilev=1,nlev)
    1229              end do
     1230             END DO
    12301231             close(9)
    12311232

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/math_lib.F90

    r5082 r5086  
    273273       exit
    274274    end if
    275   end do
     275  END DO
    276276 
    277277  if (lerror) then
    … …  
    316316    end if
    317317    ilo = ilo + 1
    318   end do
     318  END DO
    319319
    320320  ilo = max ( 2, ilo )
    … …  
    326326    end if
    327327    ihi = ihi - 1
    328   end do
     328  END DO
    329329 
    330330  ihi = min ( ihi, ntab - 1 )
    … …  
    374374    syl = x2
    375375 
    376   end do
     376  END DO
    377377 
    378378  result = sum1 &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_cosp_modis_simulator.F90

    r3233 r5086  
    176176              opticalThickness(i, j, k) = 0.   
    177177            end if
    178           end do
    179         end do
    180       end do
     178          END DO
     179        END DO
     180      END DO
    181181
    182182      !
    … …  
    197197          do i = 1, nSunlit
    198198            if(subCols%frac_out(sunlit(i), j, k) == I_CVC) opticalThickness(i, j, k) = gridBox%dtau_c(sunlit(i), k)
    199           end do
    200         end do
    201       end do
     199          END DO
     200        END DO
     201      END DO
    202202
    203203      !
    … …  
    220220                                retrievedPhase(i, :), retrievedCloudTopPressure(i, :),      &
    221221                                retrievedTau(i, :), retrievedSize(i, :))
    222      end do
     222     END DO
    223223     
    224224      ! DJS2015: Call L3 modis simulator used by cospv2.0

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/mod_modis_sim.F90

    r5082 r5086  
    331331        retrievedTau(i) = R_UNDEF
    332332      end if
    333     end do
     333    END DO
    334334    where((retrievedSize(:) < 0.).and.(retrievedSize(:) /= R_UNDEF)) retrievedSize(:) = 1.0e-06*re_fill
    335335
    … …  
    802802        tauMask(:, :, i) = .false.
    803803      end where
    804     end do
     804    END DO
    805805
    806806    do i = 1, numPressureHistogramBins
    … …  
    811811        pressureMask(:, :, i) = .false.
    812812      end where
    813     end do
     813    END DO
    814814   
    815815    do i = 1, numPressureHistogramBins
    … …  
    817817        Optical_Thickness_vs_Cloud_Top_Pressure(:, j, i) = &
    818818          real(count(tauMask(:, :, j) .and. pressureMask(:, :, i), dim = 2)) / real(nSubcols)
    819       end do
    820     end do
     819      END DO
     820    END DO
    821821   
    822822  end subroutine modis_L3_simulator
    … …  
    851851      end if
    852852      if(totalTau >= tauLimit) exit
    853     end do
     853    END DO
    854854    cloud_top_pressure = totalProduct/totalTau
    855855  end function cloud_top_pressure
    … …  
    877877      end if
    878878      if(totalTau >= tauLimit) exit
    879     end do
     879    END DO
    880880    weight_by_extinction = totalProduct/totalTau
    881881  end function weight_by_extinction
    … …  
    11141114    do i = 1, size(cloudIndicies)
    11151115      call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
    1116     end do
     1116    END DO
    11171117                   
    11181118    call adding_doubling(Refl(:), Trans(:), Refl_tot, Trans_tot) 
    … …  
    12921292          Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1 - Refl_cumulative(i-1) * Refl(i))
    12931293          Tran_cumulative(i) = (Tran_cumulative(i-1)*Tran(i)) / (1 - Refl_cumulative(i-1) * Refl(i))
    1294       end do
     1294      END DO
    12951295     
    12961296      Refl_tot = Refl_cumulative(size(Refl))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/optics_lib.F90

    r5081 r5086  
    519519
    520520!   // region from 0.045 microns to 167.0 microns - no temperature depend
    521     do i=2,nwl
    522       if(alam < wl(i)) continue
    523     enddo
    524521    x1=log(wl(i-1))
    525522    x2=log(wl(i))
    … …  
    539536    if(tk > temref(1)) tk=temref(1)
    540537    if(tk < temref(4)) tk=temref(4)
    541     do 11 i=2,4
     538    do i=2,4
    542539      if(tk>=temref(i)) go to 12
    543     11 continue
     540    END DO
    544541    12 lt1=i
    545542    lt2=i-1
    546     do 13 i=2,nwlt
     543    do i=2,nwlt
    547544      if(alam<=wlt(i)) go to 14
    548     13 continue
     545    END DO
    549546    14 x1=log(wlt(i-1))
    550547    x2=log(wlt(i))

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/scops.F

    r5082 r5086  
    161161     
    162162      !loop over vertical levels
    163       DO 200 ilev = 1,nlev
     163      DO ilev = 1,nlev
    164164                                 
    165165!     Initialise threshold
    … …  
    331331          endif
    332332
    333 200   CONTINUE    !loop over nlev
     333      END DO    !loop over nlev
    334334
    335335

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/zeff.F90

    r5082 r5086  
    113113      call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
    114114        dg, xs1, xs2, dph, err)
    115     end do
     115    END DO
    116116   
    117117  else
Note: See TracChangeset for help on using the changeset viewer.