New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3079 – NEMO

Changeset 3079


Ignore:
Timestamp:
2011-11-10T19:48:23+01:00 (12 years ago)
Author:
hliu
Message:

1).remove a bug in dynhpg.F90 2). simplified the code of dynhpg.F90

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2011/dev_r2802_NOCL_prjhpg/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r3068 r3079  
    11501150      DO jj = 2, jpjm1      
    11511151        DO ji = 2, jpim1   
    1152           zu(ji,jj,1) = - ( 0.5_wp * fse3uw(ji,jj,1) - sshu_n(ji,jj) * znad) 
    1153           zv(ji,jj,1) = - ( 0.5_wp * fse3vw(ji,jj,1) - sshv_n(ji,jj) * znad) 
     1152          zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshu_n(ji,jj) * znad) 
     1153          zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshv_n(ji,jj) * znad) 
    11541154        END DO 
    11551155      END DO 
    … …  
    11581158        DO jj = 2, jpjm1      
    11591159          DO ji = 2, jpim1   
    1160             zu(ji,jj,jk) = zu(ji,jj,jk-1)- fse3uw(ji,jj,jk) 
    1161             zv(ji,jj,jk) = zv(ji,jj,jk-1)- fse3vw(ji,jj,jk) 
     1160            zu(ji,jj,jk) = zu(ji,jj,jk-1)- fse3u(ji,jj,jk) 
     1161            zv(ji,jj,jk) = zv(ji,jj,jk-1)- fse3v(ji,jj,jk) 
    11621162          END DO 
    11631163        END DO 
    11641164      END DO 
    11651165                
    1166       !  Start pressure integration 
     1166      DO jk = 1, jpkm1                                   
     1167        DO jj = 2, jpjm1      
     1168          DO ji = 2, jpim1   
     1169            zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * fse3u(ji,jj,jk) 
     1170            zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * fse3v(ji,jj,jk) 
     1171          END DO 
     1172        END DO 
     1173      END DO 
    11671174 
    11681175      DO jk = 1, jpkm1                                   
    … …  
    11751182 
    11761183            !!!!!     for u equation 
    1177             IF(-fsde3w(ji+1,jj,mbathy(ji+1,jj)) >= -fsde3w(ji,jj,mbathy(ji,jj))) THEN 
     1184            IF(jk <= mbku(ji,jj)) THEN 
     1185            IF(-fsde3w(ji+1,jj,mbku(ji,jj)) >= -fsde3w(ji,jj,mbku(ji,jj))) THEN 
    11781186              jis = ji + 1; jid = ji 
    11791187            ELSE 
    … …  
    11841192            jk1 = jk  
    11851193            bhitwe = 0 
    1186             IF(jk1 == mbathy(jis,jj)) THEN 
    1187               bhitwe = 1 
    1188             ELSE 
    1189               DO WHILE ( -fsde3w(jis,jj,jk1+1) > zuijk ) 
    1190                 pwes = pwes + &  
    1191                      integ2(fsde3w(jis,jj,jk1),fsde3w(jis,jj,jk1+1),& 
    1192                             asp(jis,jj,jk1),bsp(jis,jj,jk1),& 
    1193                             csp(jis,jj,jk1),dsp(jis,jj,jk1)) 
    1194                 jk1 = jk1 + 1 
    1195                 IF(jk1 == mbathy(jis,jj)) THEN 
    1196                   bhitwe = 1 
    1197                   EXIT 
    1198                 END IF 
    1199               END DO 
    1200             ENDIF 
    1201              
    1202             IF(bhitwe /= 1) THEN 
     1194            DO WHILE ( -fsde3w(jis,jj,jk1) > zuijk ) 
     1195              IF(jk1 == mbku(ji,jj)) THEN 
     1196                bhitwe = 1 
     1197                EXIT 
     1198              ENDIF 
     1199              deps = min(fsde3w(jis,jj,jk1+1), -zuijk) 
    12031200              pwes = pwes + &  
    1204                    integ2(fsde3w(jis,jj,jk1),-zuijk,& 
     1201                   integ2(fsde3w(jis,jj,jk1),deps,& 
    12051202                          asp(jis,jj,jk1),bsp(jis,jj,jk1),& 
    12061203                          csp(jis,jj,jk1),dsp(jis,jj,jk1)) 
    1207             ELSE 
    1208                zuijk = -fsde3w(jis,jj,jk1) 
     1204              jk1 = jk1 + 1 
     1205            END DO 
     1206             
     1207            IF(bhitwe == 1) THEN 
     1208              zuijk = -fsde3w(jis,jj,jk1) 
    12091209            ENDIF 
    12101210 
    … …  
    12121212            jk1 = jk  
    12131213            bhitwe = 0 
    1214             IF(jk1 == 1) THEN 
    1215               bhitwe = 1 
    1216             ELSE 
    1217               DO WHILE ( -fsde3w(jid,jj,jk1-1) < zuijk ) 
    1218                 pwed = pwed + &  
    1219                      integ2(fsde3w(jid,jj,jk1-1),fsde3w(jid,jj,jk1),& 
    1220                             asp(jid,jj,jk1-1),bsp(jid,jj,jk1-1),& 
    1221                             csp(jid,jj,jk1-1),dsp(jid,jj,jk1-1)) 
    1222                 jk1 = jk1 - 1 
    1223                 IF(jk1 == 1) THEN 
    1224                   bhitwe = 1 
    1225                   EXIT 
    1226                 END IF 
    1227               END DO 
    1228             ENDIF 
    1229              
    1230             IF(bhitwe /= 1) THEN 
     1214            DO WHILE ( -fsde3w(jid,jj,jk1) < zuijk ) 
     1215              IF(jk1 == 1) THEN 
     1216                bhitwe = 1 
     1217                EXIT 
     1218              END IF 
     1219              deps = max(fsde3w(jid,jj,jk1-1), -zuijk) 
    12311220              pwed = pwed + &  
    1232                    integ2(-zuijk,fsde3w(jid,jj,jk1),& 
     1221                   integ2(deps,fsde3w(jid,jj,jk1),& 
    12331222                          asp(jid,jj,jk1-1),bsp(jid,jj,jk1-1),& 
    12341223                          csp(jid,jj,jk1-1),dsp(jid,jj,jk1-1)) 
    1235             ELSE 
     1224              jk1 = jk1 - 1 
     1225            END DO 
     1226             
     1227            IF(bhitwe == 1) THEN 
    12361228              deps = fsde3w(jid,jj,1) + min(zuijk, sshn(jid,jj)*znad) 
    12371229              rhdt1 = rhd(jid,jj,1) - interp3(fsde3w(jid,jj,1),asp(jid,jj,1), & 
    … …  
    12411233            ENDIF 
    12421234 
    1243             IF(jid > jis) THEN 
    1244               pe = pwed; pw = pwes 
    1245             ELSE 
    1246               pe = pwes; pw = pwed 
    1247             ENDIF 
    12481235 
    12491236            dpdx1 = zcoef0 / e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk)) 
    12501237            IF(lk_vvl) THEN 
    1251               dpdx2 = zcoef0 / e1u(ji,jj) * (pw + pe + (sshn(ji+1,jj)-sshn(ji,jj)))  
     1238              dpdx2 = zcoef0 / e1u(ji,jj) * &  
     1239                      (REAL(jis-jid, wp) * (pwes + pwed) + (sshn(ji+1,jj)-sshn(ji,jj)))  
    12521240             ELSE 
    1253               dpdx2 = zcoef0 / e1u(ji,jj) * (pw + pe)  
     1241              dpdx2 = zcoef0 / e1u(ji,jj) * REAL(jis-jid, wp) * (pwes + pwed)  
    12541242            ENDIF 
    12551243 
    12561244            ua(ji,jj,jk) = ua(ji,jj,jk) + (dpdx1 + dpdx2)*& 
    12571245               &           umask(ji,jj,jk)*tmask(ji,jj,jk)*tmask(ji+1,jj,jk) 
     1246            ENDIF 
    12581247   
    12591248            !!!!!     for v equation 
    1260  
    1261             IF(-fsde3w(ji,jj+1,mbathy(ji,jj+1)) >= -fsde3w(ji,jj,mbathy(ji,jj))) THEN 
     1249            IF(jk <= mbkv(ji,jj)) THEN 
     1250            IF(-fsde3w(ji,jj+1,mbkv(ji,jj)) >= -fsde3w(ji,jj,mbkv(ji,jj))) THEN 
    12621251              jjs = jj + 1; jjd = jj 
    12631252            ELSE 
    … …  
    12681257            jk1 = jk  
    12691258            bhitns = 0 
    1270             IF(jk1 == mbathy(ji,jjs)) THEN 
    1271               bhitns = 1 
    1272             ELSE 
    1273               DO WHILE ( -fsde3w(ji,jjs,jk1+1) > zvijk ) 
    1274                 pnss = pnss + &  
    1275                      integ2(fsde3w(ji,jjs,jk1),fsde3w(ji,jjs,jk1+1),& 
    1276                             asp(ji,jjs,jk1),bsp(ji,jjs,jk1),& 
    1277                             csp(ji,jjs,jk1),dsp(ji,jjs,jk1)) 
    1278                 jk1 = jk1 + 1 
    1279                 IF(jk1 == mbathy(ji,jjs)) THEN 
    1280                   bhitns = 1 
    1281                   EXIT 
    1282                 END IF 
    1283               END DO 
    1284             ENDIF 
    1285              
    1286             IF(bhitns /= 1) THEN 
     1259            DO WHILE ( -fsde3w(ji,jjs,jk1) > zvijk ) 
     1260              IF(jk1 == mbkv(ji,jj)) THEN 
     1261                bhitns = 1 
     1262                EXIT 
     1263              ENDIF 
     1264              deps = min(fsde3w(ji,jjs,jk1+1), -zvijk) 
    12871265              pnss = pnss + &  
    1288                    integ2(fsde3w(ji,jjs,jk1),-zvijk,& 
     1266                   integ2(fsde3w(ji,jjs,jk1),deps,& 
    12891267                          asp(ji,jjs,jk1),bsp(ji,jjs,jk1),& 
    12901268                          csp(ji,jjs,jk1),dsp(ji,jjs,jk1)) 
    1291             ELSE 
    1292                zvijk = -fsde3w(ji,jjs,jk1) 
     1269              jk1 = jk1 + 1 
     1270            END DO 
     1271             
     1272            IF(bhitns == 1) THEN 
     1273              zvijk = -fsde3w(ji,jjs,jk1) 
    12931274            ENDIF 
    12941275 
    … …  
    12961277            jk1 = jk  
    12971278            bhitns = 0 
    1298             IF(jk1 == 1) THEN 
    1299               bhitns = 1 
    1300             ELSE 
    1301               DO WHILE ( -fsde3w(ji,jjd,jk1-1) < zvijk ) 
    1302                 pnsd = pnsd + &  
    1303                      integ2(fsde3w(ji,jjd,jk1-1),fsde3w(ji,jjd,jk1),& 
    1304                             asp(ji,jjd,jk1-1),bsp(ji,jjd,jk1-1),& 
    1305                             csp(ji,jjd,jk1-1),dsp(ji,jjd,jk1-1)) 
    1306                 jk1 = jk1 - 1 
    1307                 IF(jk1 == 1) THEN 
    1308                   bhitns = 1 
    1309                   EXIT 
    1310                 END IF 
    1311               END DO 
    1312             ENDIF 
    1313              
    1314             IF(bhitns /= 1) THEN 
     1279            DO WHILE ( -fsde3w(ji,jjd,jk1) < zvijk ) 
     1280              IF(jk1 == 1) THEN 
     1281                bhitns = 1 
     1282                EXIT 
     1283              END IF 
     1284              deps = max(fsde3w(ji,jjd,jk1-1), -zvijk) 
    13151285              pnsd = pnsd + &  
    1316                    integ2(-zvijk,fsde3w(ji,jjd,jk1),& 
     1286                   integ2(deps,fsde3w(ji,jjd,jk1),& 
    13171287                          asp(ji,jjd,jk1-1),bsp(ji,jjd,jk1-1),& 
    13181288                          csp(ji,jjd,jk1-1),dsp(ji,jjd,jk1-1)) 
    1319             ELSE 
     1289              jk1 = jk1 - 1 
     1290            END DO 
     1291             
     1292            IF(bhitns == 1) THEN 
    13201293              deps = fsde3w(ji,jjd,1) + min(zvijk, sshn(ji,jjd)*znad) 
    13211294              rhdt1 = rhd(ji,jjd,1) - interp3(fsde3w(ji,jjd,1),asp(ji,jjd,1), & 
    … …  
    13251298            ENDIF 
    13261299 
    1327             IF(jjd > jjs) THEN 
    1328               pn = pnsd; ps = pnss 
    1329             ELSE 
    1330               pn = pnss; ps = pnsd 
    1331             ENDIF 
    13321300 
    13331301            dpdy1 = zcoef0 / e2v(ji,jj) * (zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk)) 
    13341302            if(lk_vvl) then 
    1335                 dpdy2 = zcoef0 / e2v(ji,jj) * (ps + pn + (sshn(ji,jj+1)-sshn(ji,jj)))  
     1303                dpdy2 = zcoef0 / e2v(ji,jj) * & 
     1304                        (REAL(jjs-jjd, wp) * (pnss + pnsd) + (sshn(ji,jj+1)-sshn(ji,jj)))  
    13361305              else 
    1337                 dpdy2 = zcoef0 / e2v(ji,jj) * (ps + pn )  
     1306                dpdy2 = zcoef0 / e2v(ji,jj) * REAL(jjs-jjd, wp) * (pnss + pnsd )  
    13381307            end if 
    13391308 
    13401309            va(ji,jj,jk) = va(ji,jj,jk) + (dpdy1 + dpdy2)*& 
    13411310            &              vmask(ji,jj,jk)*tmask(ji,jj,jk)*tmask(ji,jj+1,jk) 
     1311            ENDIF 
    13421312 
    13431313                     
Note: See TracChangeset for help on using the changeset viewer.