Ignore:
Timestamp:
Jul 22, 2024, 9:29:09 PM (4 months ago)
Author:
abarral
Message:

Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90
Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad
Create lmdz_yoerad.f90
(lint) Remove "!" on otherwise empty line

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/mrgrnk.F90

    r5095 r5099  
    22! Copyright (c) 2015, Regents of the University of Colorado
    33! All rights reserved.
    4 !
     4
    55! Redistribution and use in source and binary forms, with or without modification, are
    66! permitted provided that the following conditions are met:
    7 !
     7
    88! 1. Redistributions of source code must retain the above copyright notice, this list of
    99!    conditions and the following disclaimer.
    10 !
     10
    1111! 2. Redistributions in binary form must reproduce the above copyright notice, this list
    1212!    of conditions and the following disclaimer in the documentation and/or other
    1313!    materials provided with the distribution.
    14 !
     14
    1515! 3. Neither the name of the copyright holder nor the names of its contributors may be
    1616!    used to endorse or promote products derived from this software without specific prior
    1717!    written permission.
    18 !
     18
    1919! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY
    2020! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
    … …  
    2626! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
    2727! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
    28 !
     28
    2929! History:
    3030! May 2015:  Dustin Swales    - Modified for COSPv2.0
    31 !
     31
    3232! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    3333Module m_mrgrnk
    … …  
    5656    ! __________________________________________________________
    5757    Real (wp) :: XVALA, XVALB
    58     !
     58
    5959    Integer, Dimension (SIZE(IRNGT)) :: JWRKT
    6060    Integer :: LMTNA, LMTNC, IRNG1, IRNG2
    6161    Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
    62     !
     62
    6363    NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
    6464    Select Case (NVAL)
    … …  
    7171       Continue
    7272    End Select
    73     !
     73
    7474    ! Fill-in the index array, creating ordered couples
    75     !
     75
    7676    Do IIND = 2, NVAL, 2
    7777       If (XDONT(IIND-1) <= XDONT(IIND)) Then
    … …  
    8686       IRNGT (NVAL) = NVAL
    8787    End If
    88     !
     88
    8989    ! We will now have ordered subsets A - B - A - B - ...
    9090    ! and merge A and B couples into C - C - ...
    91     !
     91
    9292    LMTNA = 2
    9393    LMTNC = 4
    94     !
     94
    9595    ! First iteration. The length of the ordered subsets goes from 2 to 4
    96     !
     96
    9797    Do
    9898       If (NVAL <= 2) Exit
    99        !
     99
    100100       ! Loop on merges of A and B into C
    101        !
     101
    102102       Do IWRKD = 0, NVAL - 1, 4
    103103          If ((IWRKD+4) > NVAL) Then
    104104             If ((IWRKD+2) >= NVAL) Exit
    105              !
     105
    106106             ! 1 2 3
    107              !
     107
    108108             If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
    109              !
     109
    110110             ! 1 3 2
    111              !
     111
    112112             If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
    113113                IRNG2 = IRNGT (IWRKD+2)
    114114                IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
    115115                IRNGT (IWRKD+3) = IRNG2
    116                 !
     116
    117117                ! 3 1 2
    118                 !
     118
    119119             Else
    120120                IRNG1 = IRNGT (IWRKD+1)
    … …  
    125125             Exit
    126126          End If
    127           !
     127
    128128          ! 1 2 3 4
    129           !
     129
    130130          If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
    131           !
     131
    132132          ! 1 3 x x
    133           !
     133
    134134          If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
    135135             IRNG2 = IRNGT (IWRKD+2)
    … …  
    143143                IRNGT (IWRKD+4) = IRNG2
    144144             End If
    145              !
     145
    146146             ! 3 x x x
    147              !
     147
    148148          Else
    149149             IRNG1 = IRNGT (IWRKD+1)
    … …  
    168168          End If
    169169       End Do
    170        !
     170
    171171       ! The Cs become As and Bs
    172        !
     172
    173173       LMTNA = 4
    174174       Exit
    175175    End Do
    176     !
     176
    177177    ! Iteration loop. Each time, the length of the ordered subsets
    178178    ! is doubled.
    179     !
     179
    180180    Do
    181181       If (LMTNA >= NVAL) Exit
    182182       IWRKF = 0
    183183       LMTNC = 2 * LMTNC
    184        !
     184
    185185       ! Loop on merges of A and B into C
    186        !
     186
    187187       Do
    188188          IWRK = IWRKF
    … …  
    196196          IINDA = 1
    197197          IINDB = JINDA + 1
    198           !
     198
    199199          ! Shortcut for the case when the max of A is smaller
    200200          ! than the min of B. This line may be activated when the
    201201          ! initial set is already close to sorted.
    202           !
     202
    203203          ! IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
    204           !
     204
    205205          ! One steps in the C subset, that we build in the final rank array
    206           !
     206
    207207          ! Make a copy of the rank array for the merge iteration
    208           !
     208
    209209          JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
    210           !
     210
    211211          XVALA = XDONT (JWRKT(IINDA))
    212212          XVALB = XDONT (IRNGT(IINDB))
    213           !
     213
    214214          Do
    215215             IWRK = IWRK + 1
    216              !
     216
    217217             ! We still have unprocessed values in both A and B
    218              !
     218
    219219             If (XVALA > XVALB) Then
    220220                IRNGT (IWRK) = IRNGT (IINDB)
    … …  
    232232                XVALA = XDONT (JWRKT(IINDA))
    233233             End If
    234              !
     234
    235235          End Do
    236236       End Do
    237        !
     237
    238238       ! The Cs become As and Bs
    239        !
     239
    240240       LMTNA = 2 * LMTNA
    241241    End Do
    242     !
     242
    243243    Return
    244     !
     244
    245245  End Subroutine D_mrgrnk
    246246 
    … …  
    256256    ! __________________________________________________________
    257257    Real(wp) :: XVALA, XVALB
    258     !
     258
    259259    Integer, Dimension (SIZE(IRNGT)) :: JWRKT
    260260    Integer :: LMTNA, LMTNC, IRNG1, IRNG2
    261261    Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
    262     !
     262
    263263    NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
    264264    Select Case (NVAL)
    … …  
    271271       Continue
    272272    End Select
    273     !
     273
    274274    ! Fill-in the index array, creating ordered couples
    275     !
     275
    276276    Do IIND = 2, NVAL, 2
    277277       If (XDONT(IIND-1) <= XDONT(IIND)) Then
    … …  
    286286       IRNGT (NVAL) = NVAL
    287287    End If
    288     !
     288
    289289    ! We will now have ordered subsets A - B - A - B - ...
    290290    ! and merge A and B couples into C - C - ...
    291     !
     291
    292292    LMTNA = 2
    293293    LMTNC = 4
    294     !
     294
    295295    ! First iteration. The length of the ordered subsets goes from 2 to 4
    296     !
     296
    297297    Do
    298298       If (NVAL <= 2) Exit
    299        !
     299
    300300       ! Loop on merges of A and B into C
    301        !
     301
    302302       Do IWRKD = 0, NVAL - 1, 4
    303303          If ((IWRKD+4) > NVAL) Then
    304304             If ((IWRKD+2) >= NVAL) Exit
    305              !
     305
    306306             ! 1 2 3
    307              !
     307
    308308             If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
    309              !
     309
    310310             ! 1 3 2
    311              !
     311
    312312             If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
    313313                IRNG2 = IRNGT (IWRKD+2)
    314314                IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
    315315                IRNGT (IWRKD+3) = IRNG2
    316                 !
     316
    317317                ! 3 1 2
    318                 !
     318
    319319             Else
    320320                IRNG1 = IRNGT (IWRKD+1)
    … …  
    325325             Exit
    326326          End If
    327           !
     327
    328328          ! 1 2 3 4
    329           !
     329
    330330          If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
    331           !
     331
    332332          ! 1 3 x x
    333           !
     333
    334334          If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
    335335             IRNG2 = IRNGT (IWRKD+2)
    … …  
    343343                IRNGT (IWRKD+4) = IRNG2
    344344             End If
    345              !
     345
    346346             ! 3 x x x
    347              !
     347
    348348          Else
    349349             IRNG1 = IRNGT (IWRKD+1)
    … …  
    368368          End If
    369369       End Do
    370        !
     370
    371371       ! The Cs become As and Bs
    372        !
     372
    373373       LMTNA = 4
    374374       Exit
    375375    End Do
    376     !
     376
    377377    ! Iteration loop. Each time, the length of the ordered subsets
    378378    ! is doubled.
    379     !
     379
    380380    Do
    381381       If (LMTNA >= NVAL) Exit
    382382       IWRKF = 0
    383383       LMTNC = 2 * LMTNC
    384        !
     384
    385385       ! Loop on merges of A and B into C
    386        !
     386
    387387       Do
    388388          IWRK = IWRKF
    … …  
    396396          IINDA = 1
    397397          IINDB = JINDA + 1
    398           !
     398
    399399          ! Shortcut for the case when the max of A is smaller
    400400          ! than the min of B. This line may be activated when the
    401401          ! initial set is already close to sorted.
    402           !
     402
    403403          ! IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
    404           !
     404
    405405          ! One steps in the C subset, that we build in the final rank array
    406           !
     406
    407407          ! Make a copy of the rank array for the merge iteration
    408           !
     408
    409409          JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
    410           !
     410
    411411          XVALA = XDONT (JWRKT(IINDA))
    412412          XVALB = XDONT (IRNGT(IINDB))
    413           !
     413
    414414          Do
    415415             IWRK = IWRK + 1
    416              !
     416
    417417             ! We still have unprocessed values in both A and B
    418              !
     418
    419419             If (XVALA > XVALB) Then
    420420                IRNGT (IWRK) = IRNGT (IINDB)
    … …  
    432432                XVALA = XDONT (JWRKT(IINDA))
    433433             End If
    434              !
     434
    435435          End Do
    436436       End Do
    437        !
     437
    438438       ! The Cs become As and Bs
    439        !
     439
    440440       LMTNA = 2 * LMTNA
    441441    End Do
    442     !
     442
    443443    Return
    444     !
     444
    445445  End Subroutine R_mrgrnk
    446446  Subroutine I_mrgrnk (XDONT, IRNGT)
    … …  
    455455    ! __________________________________________________________
    456456    Integer :: XVALA, XVALB
    457     !
     457
    458458    Integer, Dimension (SIZE(IRNGT)) :: JWRKT
    459459    Integer :: LMTNA, LMTNC, IRNG1, IRNG2
    460460    Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
    461     !
     461
    462462    NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
    463463    Select Case (NVAL)
    … …  
    470470       Continue
    471471    End Select
    472     !
     472
    473473    ! Fill-in the index array, creating ordered couples
    474     !
     474
    475475    Do IIND = 2, NVAL, 2
    476476       If (XDONT(IIND-1) <= XDONT(IIND)) Then
    … …  
    485485       IRNGT (NVAL) = NVAL
    486486    End If
    487     !
     487
    488488    ! We will now have ordered subsets A - B - A - B - ...
    489489    ! and merge A and B couples into C - C - ...
    490     !
     490
    491491    LMTNA = 2
    492492    LMTNC = 4
    493     !
     493
    494494    ! First iteration. The length of the ordered subsets goes from 2 to 4
    495     !
     495
    496496    Do
    497497       If (NVAL <= 2) Exit
    498        !
     498
    499499       ! Loop on merges of A and B into C
    500        !
     500
    501501       Do IWRKD = 0, NVAL - 1, 4
    502502          If ((IWRKD+4) > NVAL) Then
    503503             If ((IWRKD+2) >= NVAL) Exit
    504              !
     504
    505505             ! 1 2 3
    506              !
     506
    507507             If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
    508              !
     508
    509509             ! 1 3 2
    510              !
     510
    511511             If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
    512512                IRNG2 = IRNGT (IWRKD+2)
    513513                IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
    514514                IRNGT (IWRKD+3) = IRNG2
    515                 !
     515
    516516                ! 3 1 2
    517                 !
     517
    518518             Else
    519519                IRNG1 = IRNGT (IWRKD+1)
    … …  
    524524             Exit
    525525          End If
    526           !
     526
    527527          ! 1 2 3 4
    528           !
     528
    529529          If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
    530           !
     530
    531531          ! 1 3 x x
    532           !
     532
    533533          If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
    534534             IRNG2 = IRNGT (IWRKD+2)
    … …  
    542542                IRNGT (IWRKD+4) = IRNG2
    543543             End If
    544              !
     544
    545545             ! 3 x x x
    546              !
     546
    547547          Else
    548548             IRNG1 = IRNGT (IWRKD+1)
    … …  
    567567          End If
    568568       End Do
    569        !
     569
    570570       ! The Cs become As and Bs
    571        !
     571
    572572       LMTNA = 4
    573573       Exit
    574574    End Do
    575     !
     575
    576576    ! Iteration loop. Each time, the length of the ordered subsets
    577577    ! is doubled.
    578     !
     578
    579579    Do
    580580       If (LMTNA >= NVAL) Exit
    581581       IWRKF = 0
    582582       LMTNC = 2 * LMTNC
    583        !
     583
    584584       ! Loop on merges of A and B into C
    585        !
     585
    586586       Do
    587587          IWRK = IWRKF
    … …  
    595595          IINDA = 1
    596596          IINDB = JINDA + 1
    597           !
     597
    598598          ! Shortcut for the case when the max of A is smaller
    599599          ! than the min of B. This line may be activated when the
    600600          ! initial set is already close to sorted.
    601           !
     601
    602602          ! IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
    603           !
     603
    604604          ! One steps in the C subset, that we build in the final rank array
    605           !
     605
    606606          ! Make a copy of the rank array for the merge iteration
    607           !
     607
    608608          JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
    609           !
     609
    610610          XVALA = XDONT (JWRKT(IINDA))
    611611          XVALB = XDONT (IRNGT(IINDB))
    612           !
     612
    613613          Do
    614614             IWRK = IWRK + 1
    615              !
     615
    616616             ! We still have unprocessed values in both A and B
    617              !
     617
    618618             If (XVALA > XVALB) Then
    619619                IRNGT (IWRK) = IRNGT (IINDB)
    … …  
    631631                XVALA = XDONT (JWRKT(IINDA))
    632632             End If
    633              !
     633
    634634          End Do
    635635       End Do
    636        !
     636
    637637       ! The Cs become As and Bs
    638        !
     638
    639639       LMTNA = 2 * LMTNA
    640640    End Do
    641     !
     641
    642642    Return
    643     !
     643
    644644  End Subroutine I_mrgrnk
    645645end module m_mrgrnk
Note: See TracChangeset for help on using the changeset viewer.